Merge every Excel file in a folder into one sheet (VBA)

The script

Attribute VB_Name = "MergeWorkbooks"
Option Explicit

' Combine the first sheet of every Excel file in a folder into one sheet.
' A "Source File" column records where each row came from.
Public Sub MergeWorkbooks()
    Dim folder As String, fileName As String
    Dim master As Worksheet, src As Workbook
    Dim data As Range
    Dim nextRow As Long, rowsCopied As Long, filesDone As Long, sourceCol As Long

    ' 1. Ask the user for a folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Choose the folder of workbooks to merge"
        If .Show <> -1 Then Exit Sub
        folder = .SelectedItems(1) & Application.PathSeparator
    End With

    ' 2. Fresh output sheet in this workbook
    Set master = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    master.Name = "Merged " & Format(Now, "yyyy-mm-dd hhmmss")
    nextRow = 1

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ' 3. Loop through every .xls / .xlsx / .xlsm file
    fileName = Dir(folder & "*.xls*")
    Do While fileName <> ""
        If fileName <> ThisWorkbook.Name And Left(fileName, 2) <> "~$" Then
            Set src = Workbooks.Open(folder & fileName, ReadOnly:=True)
            Set data = src.Worksheets(1).UsedRange

            If Application.WorksheetFunction.CountA(data) > 0 Then
                ' Header row comes from the first file only
                If nextRow = 1 Then
                    data.Rows(1).Copy master.Cells(1, 1)
                    sourceCol = data.Columns.Count + 1
                    master.Cells(1, sourceCol).Value = "Source File"
                    nextRow = 2
                End If

                ' Copy everything below the header, values only
                If data.Rows.Count > 1 Then
                    With data.Offset(1).Resize(data.Rows.Count - 1)
                        master.Cells(nextRow, 1).Resize(.Rows.Count, .Columns.Count).Value = .Value
                        master.Cells(nextRow, sourceCol).Resize(.Rows.Count, 1).Value = fileName
                        nextRow = nextRow + .Rows.Count
                        rowsCopied = rowsCopied + .Rows.Count
                    End With
                End If
            End If

            src.Close SaveChanges:=False
            filesDone = filesDone + 1
        End If
        fileName = Dir()
    Loop

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    ' 4. Tidy up and report
    master.Rows(1).Font.Bold = True
    master.Columns.AutoFit
    MsgBox "Merged " & rowsCopied & " rows from " & filesDone & " files.", vbInformation
End Sub

How it works

1. Folder picker. Application.FileDialog(msoFileDialogFolderPicker) shows the standard "choose a folder" window. If you cancel, .Show returns something other than -1 and the macro quietly exits. Application.PathSeparator adds \ on Windows or / on Mac.

2. A new sheet every run. The output goes on a fresh sheet named with a timestamp (Merged 2026-10-05 091502), so re-running never overwrites an earlier result.

Speed switches. ScreenUpdating = False stops Excel redrawing the screen as each file opens, often the biggest speed-up in any VBA macro. DisplayAlerts = False suppresses "do you want to save?" pop-ups.

3. The loop. Dir(folder & "*.xls*") returns the first matching file name, and each later Dir() call returns the next one until it returns "". Two files are skipped:

• the workbook running the macro, if it's in the same folder
• ~$ lock files that Excel creates while a workbook is open

Header once, data always. The first file's row 1 becomes the header and the "Source File" column is added after it. From every file, data.Offset(1).Resize(...) selects everything below the header.

Values, not copy/paste. target.Value = source.Value copies values directly without using the clipboard. It's much faster than .Copy and leaves formulas, formatting and links to other workbooks behind.

4. Report. Bold header, auto-fit columns, and a message box with row and file counts so you can sanity-check the result.

Running it

1. Open the workbook you want the merged sheet in (save it as .xlsm).
2. Press Alt + F11 to open the VBA editor.
3. File → Import File… and choose MergeWorkbooks.bas, or Insert → Module and paste the code.
4. Back in Excel, press Alt + F8, pick MergeWorkbooks, then Run.

All source files should have the same columns in the same order. The macro stacks by position, not by header name.

Variations

Use a named sheet instead of the first one. Replace src.Worksheets(1) with src.Worksheets("Data").

Only merge CSV files. Change the pattern to Dir(folder & "*.csv"). Workbooks.Open reads CSVs too.

Include subfolders. Dir only looks in one folder. For subfolders, use CreateObject("Scripting.FileSystemObject") and recurse through .SubFolders. Note this only works on Windows.

Files with different column orders. Use Power Query instead (Data → Get Data → From Folder). It matches columns by header name and can be refreshed with one click next week.

Guard against extra columns. If a later file has more columns than the first, its extra columns land where "Source File" is. To check, compare data.Columns.Count with sourceCol - 1 and Debug.Print a warning.