Export multiple worksheets into one csv file

[golphtech]

I am looking for way to export multiple worksheets from a single workbook to a single csv file (or to a new excel file). I've been googling all over with no luck. Total VB noob here. Thanks for any help!!

[SamT]

Golphtech,

Welcome to the best VBA forum on the web.

Unless all the sheets have exactly the same column labels with exactly the same types of information, you really DON'T want to put them all in the same csv file.

Unless: If you were to paste all the sheets except Row #1 into one sheet with each sheet's Rows pasted under the preceeding sheet's, the new sheet still makes sense.

Does that make sense? Sometimes I'm as clear as thick Missouri mud.

[Kenneth Hobs]

Post a very short example file. As Sam said, to make a true master CSV file, sheet columns need to have the same structure.

[golphtech]

I came up with a code but still trying to figure out how to attach it here. Thanks for all the replies! Really appreciate it!

[SamT]

In the Reply Editor, click the # button on the menu and paste your code in between the two code tags that appear. Alternately you can type the tags before and after your code.

[code] ...Your code here...[/code]

Ignore the words "HTML Code:"

[stanleydgrom]

golphtech,

Welcome to the VBA Express forum.

If posting VBA code, please use Code Tags - like this:

[code]

'Paste your code here.

[/code]

[golphtech]

Thanks for the reply everyone! Basically, what I came up with is creating a new workbook that imports data from another workbook. It works but I need to clean/tune the code, I think a loop might do the trick! Any suggestions is greatly appreciated.

Sub Import()

Const sRANGE = "B3:I65536"

 ' Hide screen updates
    Application.ScreenUpdating = False
    
 ' Start with clean worksheet
    Cells.Select
    Selection.ClearContents
    
 ' Open source file
    Workbooks.Open Filename:="IP Matrix.xlsx"
    
 ' Copy Sheet1
    Sheets("01").Select
    Range(sRANGE).Select
    Selection.Copy
    Windows("IP Import.xlsm").Activate
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     
 ' Copy Sheet 2
    Windows("IP Matrix.xlsx").Activate
    Sheets("02").Select
    Range(sRANGE).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("IP Import.xlsm").Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
 ' Copy Sheet 3
    Windows("IP Matrix.xlsx").Activate
    Sheets("03").Select
    Range(sRANGE).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("IP Import.xlsm").Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 ' Copy Sheet 4
    Windows("IP Matrix.xlsx").Activate
    Sheets("04").Select
    Range(sRANGE).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("IP Import.xlsm").Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 ' Copy Sheet 5
    Windows("IP Matrix.xlsx").Activate
    Sheets("05").Select
    Range(sRANGE).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("IP Import.xlsm").Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 ' Copy Sheet 6
    Windows("IP Matrix.xlsx").Activate
    Sheets("06").Select
    Range(sRANGE).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("IP Import.xlsm").Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 ' Copy Sheet 7
    Windows("IP Matrix.xlsx").Activate
    Sheets("07").Select
    Range(sRANGE).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("IP Import.xlsm").Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 ' Copy Sheet 8
    Windows("IP Matrix.xlsx").Activate
    Sheets("08").Select
    Range(sRANGE).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("IP Import.xlsm").Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 ' Copy Sheet 9
    Windows("IP Matrix.xlsx").Activate
    Sheets("09").Select
    Range(sRANGE).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("IP Import.xlsm").Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 ' Copy Sheet 10
    Windows("IP Matrix.xlsx").Activate
    Sheets("10").Select
    Range(sRANGE).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("IP Import.xlsm").Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 ' Copy Sheet Others
    Windows("IP Matrix.xlsx").Activate
    Sheets("Others").Select
    Range(sRANGE).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("IP Import.xlsm").Activate
    Range("A65536").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 ' Remove unnecessary columns
    Columns("B:G").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select

 ' Close source
    Windows("IP Matrix.xlsx").Activate
    Application.DisplayAlerts = False
    ActiveWindow.Close

End Sub

[SamT]

See if this makes sense to you.

Option Explicit

Sub Import()
    Dim CB As Workbook  'Copy Book
    Dim CSs As Variant  'Copy Sheets
    Dim PS As Worksheet 'Paste Sheet
    Dim i As Long       'Iteration Counter
    Const LR As Long = Application.Rows.Count 'LastRow
    
    Workbooks.Open Filename:="IP Matrix.xlsx"
    Set CB = Workbooks("IP Matrix.xlsx")
    CSs = Split("01,02,03,04,05,06,07,08,09,10,Others", ",", -1, 1)
    Set PS = Workbooks("IP Import.xlsm").Sheets("") 'Unknown. You must set
    
     ' Hide screen updates
    Application.ScreenUpdating = False
     
     ' Start with clean worksheet
    PS.Cells.ClearContents
     
    'Copy and paste from each sheet in CSs
    For i = 0 To UBound(CSs)
      CB.Sheets(CSs(i)).Range(Range("B3"), Cells(LR, "I").End(xlUp)).Copy
      PS.Range(LR, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    Next i
     
     ' Remove unnecessary columns and empty Row 1
    With PS
      .Columns("B:G").Delete
      .Rows(1).Delete
      .Range("A1").Select
    End With
     
     ' Close source
    Application.DisplayAlerts = False
    CB.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
     
End Sub

[snb]

Welcome to the best VBA forum on the web.

Did you compare with all German, Dutch, Spanish, Russian and Chinese fora ? Or are you being a 'little' too US-centric ?

[snb]

or

sub M_snb()
  with getobject("G:\OF\IP Matrix.xlsx")
    for each sh in .sheets
      sn=sh.usedrange.offset(2,1)

      for j=1 to ubound(sn)-2
        c00=c00 & vbcrlf & join(application.index(sn,j,0),",")
      next
    next

    close false
  end with

  createobject("scripting.filesystemobject").createtextfile("G:\OF\together.csv").write c00
 End Sub

[SamT]

And he takes one for the team!

@ Golphtech,

snb's code will create a csv file named together.csv from all the sheets in IP Matrix.xlsx

[snb]

Ouch, that hurts !

[golphtech]

Wow! Thanks for the codes, I'll definitely work on these now! Will post an update soon! Much appreciated SamT and snb!

[golphtech]

Hi SamT, I am getting a Debug error on line "Const LR As Long = Application.Rows.Count 'LastRow". It says Constant expression required. Not sure what to enter there, also on the "Set PS", do I just assign the sheet number where all the data will be dumped? Thanks for all your help!!

[golphtech]

Thanks snb! Quick question on the code, how can I export the csv to a generic path such as %USERPROFILE%\Desktop. I'll be sharing the macro with a number of people so I was hoping for a more generic path without users having to modify the code. Thanks again!!

[Kenneth Hobs]

createobject("scripting.filesystemobject").createtextfile(CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\together.csv").write c00

[golphtech]

Thanks Kenneth! It worked perfectly! Thanks again!!

[SamT]

Const LR As Long = Application.Rows.Count

You just need to change it to a variable inside the sub

Dim LR as Long
LR = Application.Rows.Count

[snb]

If you like ADO:

Sub sheets_in_active_workbook_to_csv_ADO()
    '   reference Microsoft ActiveX Data Object 2.0

    For Each sh In Sheets
        With New ADODB.Recordset
            .Open "SELECT * FROM `" & sh.Name & "$`", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sh.Parent.FullName & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
            c00 = c00 & .GetString(, , ",", vbCrLf)
        End With
    Next
    
    CreateObject("scripting.filesystemobject").createtextfile(CreateObject("wscript.shell").specialfolders(4) & "\together.csv").write c00
End Sub

[golphtech]

If you like ADO:

Sub sheets_in_active_workbook_to_csv_ADO()
    '   reference Microsoft ActiveX Data Object 2.0

    For Each sh In Sheets
        With New ADODB.Recordset
            .Open "SELECT * FROM `" & sh.Name & "$`", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sh.Parent.FullName & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
            c00 = c00 & .GetString(, , ",", vbCrLf)
        End With
    Next
    
    CreateObject("scripting.filesystemobject").createtextfile(CreateObject("wscript.shell").specialfolders(4) & "\together.csv").write c00
End Sub

Thanks snb! How do I customize the code? When I run it on my source workbook I get a "type not defined" error on line "With New ADODB.Recordset". Many thanks!