I have a solution which copies the csv data to excel sheet but it works for only 1 CSV file to 1 Excel sheet. How to transfer multiple CSV files to multiple sheets in Excel?
Here is my code:
Dim oExcel
Set oExcel = CreateObject("Excel.Application")
With oExcel
.DefaultSaveFormat=51
.Workbooks.Open sourceFile
.Sheets(1).Columns("A").TextToColumns .Range("A1"), , , , , True
.Sheets.add
.ActiveWorkbook.SaveAs outputFile, 51
.Quit
End With
You actually don't need to use TextToColumns
. For the first CSV file, the sheet is already there and for the second one, you can open the file as another workbook, then use the Worksheet.Copy
method to copy the sheet after the first one.
There you go:
Const xlWorkbookDefault = 51
Dim sourceFile1, sourceFile2, outputFile
Dim xlApp, xlWorkbook1, xlWorkbook2
sourceFile1 = "...\CSV1.csv"
sourceFile2 = "...\CSV2.csv"
outputFile = "...\output.xlsx"
Set xlApp = CreateObject("Excel.Application")
With xlApp
Set xlWorkbook1 = .Workbooks.Open(sourceFile1)
Set xlWorkbook2 = .Workbooks.Open(sourceFile2)
xlWorkbook2.Sheets(1).Copy , xlWorkbook1.Sheets(1)
xlWorkbook2.Close
.xlWorkbook1.SaveAs outputFile, xlWorkbookDefault
.Quit
End With
To make it more generic, you can adjust the previous code to work with any number of CSV files:
Const xlWorkbookDefault = 51
Dim sourceFiles(5)
Dim outputFile
Dim xlApp, xlWorkbook1, xlWorkbook2
sourceFiles(0) = "...\CSV1.csv"
sourceFiles(1) = "...\CSV2.csv"
sourceFiles(2) = '...
' TODO: Add more files.
outputFile = "...\output.xlsx"
Set xlApp = CreateObject("Excel.Application")
With xlApp
Set xlWorkbook1 = .Workbooks.Open(sourceFiles(0))
For i = 1 To UBound(sourceFiles)
Set xlWorkbook2 = .Workbooks.Open(sourceFiles(i))
xlWorkbook2.Sheets(1).Copy , xlWorkbook1.Sheets(i)
xlWorkbook2.Close
Next
.xlWorkbook1.SaveAs outputFile, xlWorkbookDefault
.Quit
End With