Forum Discussion

Copper Contributor

Apr 13, 2021

Solved

VBA - export two ranges to a CSV file

Hi everyone! I have the following VBA code that saves a Excel range in a CSV file. But I need to increment this code so that I can insert, in the same CSV file, a second sheet with another Exce...

Apr 14, 2021

Like this:

Sub saveRangeToCSV()
    Dim myCSVFileName As String
    Dim myWB As Workbook
    Dim tempWB As Workbook
    Dim ws As Worksheet
    Dim rngToSave As Range
    'Dim Sharepoint As String
    'Dim Usuario As String
    Dim Protocolo As String

    Set myWB = ActiveWorkbook ' or ThisWorkbook
    'Sharepoint = myWB.Sheets("Config").Range("D5").Text
    'Usuario = myWB.Sheets("Config").Range("L6").Text
    'Protocolo = myWB.Sheets("Config").Range("J6").Text

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error GoTo err

    ' First export
    Set tempWB = Workbooks.Add(xlWBATWorksheet)
    Set ws = tempWB.Worksheets(1)
    ws.Name = "Export A"
    Set rngToSave = myWB.Worksheets("Config").Range("J5:BB6")
    rngToSave.Copy
    ws.Range("A1").PasteSpecial xlPasteValues
    myCSVFileName = myWB.Path & "\" & "CSV-Exported-File-A-" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"
    With tempWB
        .SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
        .Close
    End With

    ' Second export
    Set tempWB = Workbooks.Add(xlWBATWorksheet)
    Set ws = tempWB.Worksheets(1)
    ws.Name = "Export B"
    Set rngToSave = myWB.Worksheets("Config").Range("D8:E20")
    rngToSave.Copy
    ws.Range("A1").PasteSpecial xlPasteValues
    myCSVFileName = myWB.Path & "\" & "CSV-Exported-File-B-" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"
    With tempWB
        .SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
        .Close
    End With

err:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

HansVogelaar

MVP

Apr 13, 2021

LeandroCampacci

Try something along the following lines:

Sub saveRangeToCSV()
    Dim myCSVFileName As String
    Dim myWB As Workbook
    Dim tempWB As Workbook
    Dim rngToSave As Range
    Dim Sharepoint As String
    Dim Usuario As String
    Dim Protocolo As String
    
    Set myWB = ActiveWorkbook ' or ThisWorkbook
    Sharepoint = myWB.Sheets("Config").Range("D5").Text
    Usuario = myWB.Sheets("Config").Range("L6").Text
    Protocolo = myWB.Sheets("Config").Range("J6").Text

    Application.DisplayAlerts = False
    On Error GoTo err

    myCSVFileName = Sharepoint & "\" & Usuario & " " & Protocolo & _
        " " & Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"

    Set tempWB = Application.Workbooks.Add(1)
    With tempWB
        Set rngToSave = myWB.Worksheets("SheetOne").Range("J6:BB6")
        rngToSave.Copy
        .Sheets(1).Range("A1").PasteSpecial xlPasteValues
        Set rngToSave = myWB.Worksheets("SheetTwo").Range("J6:BB6")
        rngToSave.Copy
        .Sheets(1).Range("A2").PasteSpecial xlPasteValues
        .SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
        .Close
    End With

err:
    Application.DisplayAlerts = True
End Sub

LeandroCampacci

Copper Contributor

Apr 13, 2021

~~Helo! It doesn't seem to work. The routine creates a new file and pastes only the first interval. There is no creation of a second sheet and the process for opening the new temporary file.~~

~~Edit: seems to work until firts copy and paste. The code stops when to select the second interval.~~

Nevermind. Works so fine, but how I add the second range as a new sheet?

It's possible to rename these two new sheets?

HansVogelaar

MVP

Apr 13, 2021

LeandroCampacci

For example:

Sub saveRangeToCSV()
    Dim myCSVFileName As String
    Dim myWB As Workbook
    Dim tempWB As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rngToSave As Range
    Dim Sharepoint As String
    Dim Usuario As String
    Dim Protocolo As String

    Set myWB = ActiveWorkbook ' or ThisWorkbook
    Sharepoint = myWB.Sheets("Config").Range("D5").Text
    Usuario = myWB.Sheets("Config").Range("L6").Text
    Protocolo = myWB.Sheets("Config").Range("J6").Text

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error GoTo err

    myCSVFileName = Sharepoint & "\" & Usuario & " " & Protocolo & _
        " " & Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"

    Set tempWB = Workbooks.Add(xlWBATWorksheet)
    Set ws1 = tempWB.Worksheets(1)
    ws1.Name = "Name 1"
    Set ws2 = tempWB.Worksheets.Add(After:=ws1)
    ws2.Name = "Name 2"

    Set rngToSave = myWB.Worksheets("SheetOne").Range("J6:BB6")
    rngToSave.Copy
    ws1.Range("A1").PasteSpecial xlPasteValues
    Set rngToSave = myWB.Worksheets("SheetTwo").Range("J6:BB6")
    rngToSave.Copy
    ws2.Range("A1").PasteSpecial xlPasteValues
    With tempWB
        .SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
        .Close
    End With

err:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

LeandroCampacci
Copper Contributor
Apr 13, 2021
Don't work.

If I don't rename "SheetOne" or "SheetTwo", the macro works until create a new temp file with no data.

When change the sheet name (both ranges in "Config" sheet), only second range works.

I used this code model, since I need a lot of data and I will have commas in some cells. Will this interfere?

http://learnexcelmacro.com/wp/2017/09/save-excel-range-data-as-csv-file-through-excel-vba/#VBA-to-save-excel-range-to-csv-method-2