Read multiple CSV files and write each file content as a separate sheet in a excel spreadsheet

Question

Need to read multiple CSV files (e.g. file1, file2..) from folder1 and write each of these files as a separate sheet in the target excel. Also, read similar CSV files(e.g. file1, file2..) from folder2 and write each csv file to the above excel in the already existing sheets.

**** Source ****

Folder1:

file1:

col1, col2, col3
A, B, C
1, 2, 3

file2:

col1, col2, col3
U, V, W
4, 5, 6

Folder2:

file1:

col1, col2, col3
D, E, F
1, 2, 3

file2:

col1, col2, col3
X, Y, Z
4, 5, 6

**** Target ****

Excel:

sheet1 (file1):

col1, col2, col3 col1, col2, col3 
A, B, C, D, E, F
1, 2, 3, 4, 5, 6

sheet2 (file2):

col1, col2, col3 col1, col2, col3
U, V, W, X, Y, Z
4, 5, 6, 4, 5, 6

Code:

Private Sub Workbook_Open()
   Call OpenCSVFile
End Sub

Sub OpenCSVFile()

    Dim prevRunFolderPath As String
    Dim destFolderPath As String
    Dim prevFileName As String
    Dim destFileName As String
    Dim row_count As Integer
    Dim comp_count As Integer
    Dim lineFromFile As String
    Dim lineItems() As String
    Dim wb As Workbook
    Dim prevVer As String
    Dim currVer As String
    Dim fileExtn As String

    prevRunFolderPath = "X:\"
    currRunFolderPath = "Y:\"
    destFolderPath = "Z:\"

    prevFileName = "file1.CSV"
    currFileName = "file2.CSV"

    destFileName = "Compare.xlsx"
    fileExtn = "*.CSV*"


    ' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
    Open prevRunFolderPath & prevFileName For Input As #1
    Open currRunFolderPath & currFileName For Input As #2

    Set wb = Workbooks.Add
    '    Workbooks.Add.SaveAs Filename:=destFolderPath & destFileName
    wb.SaveAs Filename:=destFolderPath & destFileName

    'ObjExcel.Add.SaveAs Filename:=destFolderPath & destFileName
    'Workbooks(destFolderPath & destFileName).Activate
    'ActiveWorkbook.Worksheets.Add.Name = "Test"

    row_count = 1
    prevVer = "Prev-Ver"
    currVer = "Curr-Ver"

'*** Below sets the column headers ****

    wb.Worksheets("Sheet1").Range("A" & row_count).Value = prevVer & "-Desc"
    wb.Worksheets("Sheet1").Range("B" & row_count).Value = prevVer & "-Scenario"
    wb.Worksheets("Sheet1").Range("C" & row_count).Value = prevVer & "-TC1"
    wb.Worksheets("Sheet1").Range("D" & row_count).Value = prevVer & "-TC2"
    wb.Worksheets("Sheet1").Range("E" & row_count).Value = prevVer & "-Status"

    wb.Worksheets("Sheet1").Range("F" & row_count).Value = currVer & "-Desc"
    wb.Worksheets("Sheet1").Range("G" & row_count).Value = currVer & "-Scenario"
    wb.Worksheets("Sheet1").Range("H" & row_count).Value = currVer & "-TC1"
    wb.Worksheets("Sheet1").Range("I" & row_count).Value = currVer & "-TC2"
    wb.Worksheets("Sheet1").Range("J" & row_count).Value = currVer & "-Status"

    wb.Worksheets("Sheet1").Range("K" & row_count).Value = "TC1-Comp"
    wb.Worksheets("Sheet1").Range("L" & row_count).Value = "TC2-Comp"
    wb.Worksheets("Sheet1").Range("M" & row_count).Value = "Status-Comp"

    row_count = 2

*** Below loops through file1 and write the data  to target excel ****    
    Do Until EOF(1)

        Line Input #1, lineFromFile

        'MsgBox "Line is" & LineFromFile

        lineItems = Split(lineFromFile, ",")

        wb.Worksheets("Sheet1").Range("A" & row_count).Value = lineItems(0)
        wb.Worksheets("Sheet1").Range("B" & row_count).Value = lineItems(1)
        wb.Worksheets("Sheet1").Range("C" & row_count).Value = lineItems(2)
        wb.Worksheets("Sheet1").Range("D" & row_count).Value = lineItems(3)
        wb.Worksheets("Sheet1").Range("E" & row_count).Value = lineItems(4)
        row_count = row_count + 1

        ' ActiveCell.Offset(row_number,
    Loop 'Until row_count > 4

    row_count = 2

'*** Below loops through file2 and write the data  to target excel **** 

    Do Until EOF(2)

        Line Input #2, lineFromFile

        'MsgBox "Line is" & LineFromFile

        lineItems = Split(lineFromFile, ",")


        wb.Worksheets("Sheet1").Range("F" & row_count).Value = lineItems(0)
        wb.Worksheets("Sheet1").Range("G" & row_count).Value = lineItems(1)
        wb.Worksheets("Sheet1").Range("H" & row_count).Value = lineItems(2)
        wb.Worksheets("Sheet1").Range("I" & row_count).Value = lineItems(3)
        wb.Worksheets("Sheet1").Range("J" & row_count).Value = lineItems(4)
        row_count = row_count + 1

        ' ActiveCell.Offset(row_number,
    Loop 'Until row_count > 4

    comp_count = 2

'*** Below does comparisions based on the data written to the target excel ***
    Do

        wb.Worksheets("Sheet1").Range("K" & comp_count).Value = "=C" & comp_count & "=H" & comp_count
        wb.Worksheets("Sheet1").Range("L" & comp_count).Value = "=D" & comp_count & "=I" & comp_count
        wb.Worksheets("Sheet1").Range("M" & comp_count).Value = "=E" & comp_count & "=J" & comp_count

        comp_count = comp_count + 1

        ' ActiveCell.Offset(row_number,
    Loop Until comp_count > row_count

   ' Close outFileName
    Close #1
    Close #2
    wb.Save
    wb.Close

End Sub

Not sure how I can replicate it for the rest of the CSV files as all the CSV files content is being written to a single sheet instead of individual sheets.

Answer 1

Supposing you have 1 folder with a number of CSV files, and another folder with the same amount of files with the same name. So you can process all files this way:

Dim folder1 as string, folder2 as string
Dim fname as string   ' current filename
Dim sh as Worksheet

Set wb = Workbooks.Add
If Err.Number <> 0 Then 
             ' handle error here
End If

wb.SaveAs Filename:=destFolderPath & destFileName
If Err.Number <> 0 Then 
        ' handle error here
End If

fname = Dir(folder1 & Application.PathSeparator & "*.csv")
If Err.Number <> 0 Then 
    ' handle error here
ElseIf fname = vbNullString Then
    ' no CSV file exists in folder 1
Else

    Do
        Open folder1 & Application.PathSeparator & fName For Input As #1
        If Err.Number <> 0 Then 
             ' handle error here
        End If
        Open folder2 & Application.PathSeparator & fName For Input As #2
        If Err.Number <> 0 Then 
             ' handle error here
        End If

     ' input files are open, add destination sheet
        Set sh = wb.Sheets.Add(after:=wb.Sheets(Sheets.Count)) ' add new sheet
        If Err.Number <> 0 Then 
             ' handle error here
        End If
        sh.Name = Split(fname, ".")(0)    ' rename sheet to name of current file w/o ".CSV"


  ' at this point you can fill dest file with header and data

  ' replace wb.Worksheets("Sheet1").Range("E" & row_count) kind of references with sh.Range("E" & row_count)

        Close #1
        Close #2

        fname = Dir   ' get next file from folder 1
     Loop Until sFile = vbNullString          ' until file exists
 End If

Remarks:

It's worth checking Err.Number for success after each file/workbook/sheet operation.

A new workbook will have the default number of sheets. With the above algorithm these sheets will remain empty. All added sheets will have the name of the source file.

sh.Cells(row_count, 5) type of reference may be more convenient in this case instead of sh.Range("E" & row_count)

Answer 2

This works fine for me.

Sub CombineCsvFiles()
'updateby Extendoffice 20151015
    Dim xFilesToOpen As Variant
    Dim I As Integer
    Dim xWb As Workbook
    Dim xTempWb As Workbook
    Dim xDelimiter As String
    Dim xScreen As Boolean
    On Error GoTo ErrHandler
    xScreen = Application.ScreenUpdating
    Application.ScreenUpdating = False
    xDelimiter = "|"
    xFilesToOpen = Application.GetOpenFilename("Text Files (*.csv), *.csv", , "Kutools for Excel", , True)
    If TypeName(xFilesToOpen) = "Boolean" Then
        MsgBox "No files were selected", , "Kutools for Excel"
        GoTo ExitHandler
    End If
    I = 1
    Set xTempWb = Workbooks.Open(xFilesToOpen(I))
    xTempWb.Sheets(1).Copy
    Set xWb = Application.ActiveWorkbook
    xTempWb.Close False
    Do While I < UBound(xFilesToOpen)
        I = I + 1
        Set xTempWb = Workbooks.Open(xFilesToOpen(I))
        xTempWb.Sheets(1).Move , xWb.Sheets(xWb.Sheets.Count)
    Loop
ExitHandler:
    Application.ScreenUpdating = xScreen
    Set xWb = Nothing
    Set xTempWb = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description, , "Kutools for Excel"
    Resume ExitHandler
End Sub