Forum Discussion

LeandroCampacci's avatar
LeandroCampacci
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 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

 

excel
Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    Apr 14, 2021

    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

     

10 Replies

  • HansVogelaar's avatar
    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's avatar
      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's avatar
        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

Resources