VBA - export two ranges to a CSV file

[LeandroCampacci]

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 Excel range.

How?

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
    
    Sharepoint = Sheets("Config").Range("D5").Text
    Usuario = Sheets("Config").Range("L6").Text
    Protocolo = Sheets("Config").Range("J6").Text

    Application.DisplayAlerts = False
    On Error GoTo err

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

    Set rngToSave = Range("J6:BB6")
    rngToSave.Copy

    Set tempWB = Application.Workbooks.Add(1)
    With tempWB
        .Sheets(1).Range("A1").PasteSpecial xlPasteValues
        .SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
        .Close
    End With
    
err:
    Application.DisplayAlerts = True
End Sub

[#2]

@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

[#3]

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?

[#4]

@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

[#5]

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-sa...

[#6]

@LeandroCampacci 

Could you attach a copy of your workbook without sensitive data?

[#7]

@Hans Vogelaar Sure!

[#8]

@LeandroCampacci 

Ah - of course, stupid of me.

A .csv file is a text file, It cannot contain multiple worksheets!

So only one of the ranges ends up in the .csv file.

Would it be OK to export 2 csv files?

[#9]

No problem! True, I also forgot this. How would it look for two files?

[#10 · Accepted solution]

@LeandroCampacci 

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

[#11]

Worked so fine. Thanks for the support, Hans!