Attribute VB_Name = "CombineCsvFiles"
Option Explicit

' Combine every CSV file in a folder into one new sheet
' Free module from sourabsaha.com
'
' The header row is taken from the first file. Every file after that
' adds its data rows only, and a "Source file" column shows where each row came from.

Public Sub CombineCsvFiles()
    Dim folder As String, fileName As String
    Dim target As Worksheet, src As Workbook
    Dim nextRow As Long, lastRow As Long, lastCol As Long
    Dim sourceCol As Long, fileCount As Long

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choose the folder that holds your CSV files"
        If .Show <> -1 Then Exit Sub
        folder = .SelectedItems(1) & Application.PathSeparator
    End With

    fileName = Dir(folder & "*.csv")
    If fileName = "" Then
        MsgBox "No CSV files were found in that folder.", vbExclamation
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Set target = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    nextRow = 1

    Do While fileName <> ""
        Set src = Workbooks.Open(folder & fileName, Local:=True)
        With src.Worksheets(1)
            lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

            If fileCount = 0 Then
                ' First file: copy the header row as well
                .Range(.Cells(1, 1), .Cells(1, lastCol)).Copy target.Cells(1, 1)
                sourceCol = lastCol + 1
                target.Cells(1, sourceCol).Value = "Source file"
                nextRow = 2
            End If

            If lastRow > 1 Then
                .Range(.Cells(2, 1), .Cells(lastRow, lastCol)).Copy target.Cells(nextRow, 1)
                target.Range(target.Cells(nextRow, sourceCol), target.Cells(nextRow + lastRow - 2, sourceCol)).Value = fileName
                nextRow = nextRow + lastRow - 1
            End If
        End With
        src.Close SaveChanges:=False
        fileCount = fileCount + 1
        fileName = Dir()
    Loop

    target.Rows(1).Font.Bold = True
    target.Columns.AutoFit
    Application.ScreenUpdating = True
    MsgBox fileCount & " file(s) combined into " & nextRow - 2 & " rows.", vbInformation
End Sub