Combine Workbook Importer: Import Every Sheet from an Entire Folder in One Click

TL;DR: Point the macro at a folder of .xlsx files — 12 entity workbooks from a client, 8 state templates from the firm library, 5 prior-year schedules from the archive — and every sheet lands in your current workbook. Each sheet is prefixed with the source filename, and a “Source-File” column tracks exactly which file the data came from. What used to take an hour of manual sheet-moving now takes under 10 seconds.

The Problem

The client sends a zip file with 12 entity workbooks. Each has a trial balance, a fixed asset schedule, and a state apportionment tab — 36 sheets total. You need all of them in one consolidation workbook so you can build the combined federal return. The manual approach: open Entity-A.xlsx, right-click each sheet tab → Move or Copy → select your master workbook → pick the insert position → OK. Close Entity-A without saving. Repeat for Entity-B through Entity-L. Forty minutes later, you’re done — and you realize Entity-H’s trial balance is missing because you clicked “Don’t Save” before the move completed. Start over.

#Prerequisites & Setup

What you’ll need:

Excel 2016+ (desktop)
A master workbook open (the destination — this is where all sheets land)
A folder containing the .xlsx or .xlsm files you want to import
The source workbooks do NOT need to be open — the macro opens and closes them automatically

Limitations:

Sheet names are prefixed with the source filename and truncated to Excel’s 31-character limit — long workbook names + long sheet names may get cut off
Only imports sheets from .xlsx and .xlsm files — .xls (legacy binary format) and .csv files are skipped
Does not merge data from identically-named sheets — each imported sheet becomes a separate tab. If two workbooks both have a “TB” sheet, you’ll get “[Entity-A] TB” and “[Entity-B] TB”
The Source-File column is added to every imported sheet — if the destination workbook already has sheets with data in column A, the Source-File column is inserted at column A, shifting existing data to the right

#The Macro

Option Explicit

Sub CombineWorkbookImporter()
    ' ── Combine Workbook Importer ──────────────────────
    ' Imports every sheet from every .xlsx and .xlsm
    ' file in a user-selected folder into the active
    ' workbook. Prefixes sheet names with the source
    ' filename and adds a "Source-File" column.
    '
    ' Works on any set of workbooks. No setup needed.
    ' ────────────────────────────────────────────────────

    ' ── State management ───────────────────────────────
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ' ── Error handling ─────────────────────────────────
    On Error GoTo CleanUp

    ' ── Variables ──────────────────────────────────────
    Dim folderPath As String
    Dim srcFile As String
    Dim srcWb As Workbook
    Dim srcWs As Worksheet
    Dim newName As String
    Dim fileCount As Long
    Dim sheetCount As Long
    Dim skipCount  As Long
    Dim fileMsg    As String

    ' ── Select folder ─────────────────────────────────
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select the folder containing workbooks to import"
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        Else
            MsgBox "Import cancelled.", vbInformation, "Cancelled"
            GoTo CleanUp
        End If
    End With

    ' ── Ensure trailing backslash ──────────────────────
    If Right(folderPath, 1) <> "\" Then
        folderPath = folderPath & "\"
    End If

    ' ── Scan folder for .xlsx and .xlsm files ──────────
    srcFile = Dir(folderPath & "*.xlsx")
    If srcFile = "" Then srcFile = Dir(folderPath & "*.xlsm")
    If srcFile = "" Then
        MsgBox "No .xlsx or .xlsm files found in:" & vbCrLf & _
               folderPath, vbExclamation, "No Files Found"
        GoTo CleanUp
    End If

    fileCount = 0
    sheetCount = 0
    skipCount = 0

    ' ── Import loop ────────────────────────────────────
    Do While srcFile <> ""
        Set srcWb = Workbooks.Open(folderPath & srcFile, _
                                    ReadOnly:=True, UpdateLinks:=False)
        For Each srcWs In srcWb.Worksheets
            ' Build truncated sheet name
            newName = "[" & Left(srcFile, _
                InStrRev(srcFile, ".") - 1) & "] " & srcWs.Name
            If Len(newName) > 31 Then
                newName = Left(newName, 28) & "..."
            End If

            ' Copy sheet to this workbook
            On Error Resume Next
            srcWs.Copy After:=ThisWorkbook.Sheets( _
                ThisWorkbook.Sheets.Count)
            If Err.Number <> 0 Then
                skipCount = skipCount + 1
                Err.Clear
                On Error GoTo CleanUp
                GoTo NextSrcSheet
            End If
            On Error GoTo CleanUp

            ' Rename the copied sheet
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) _
                .Name = DeduplicateName(newName)

            ' Insert Source-File column
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) _
                .Columns("A:A").Insert Shift:=xlToRight
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) _
                .Cells(1, 1).Value = "Source-File"
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) _
                .Cells(1, 1).Font.Bold = True
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) _
                .Range("A2", .Cells( _
                ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) _
                .Cells(.Rows.Count, 2).End(xlUp).Row, 1)) _
                .Value = srcFile

            sheetCount = sheetCount + 1

NextSrcSheet:
        Next srcWs

        srcWb.Close SaveChanges:=False
        fileCount = fileCount + 1

        ' Get next file (check both extensions)
        srcFile = Dir()
        If srcFile = "" Then
            srcFile = Dir(folderPath & "*.xlsm")
            Do While srcFile <> ""
                Set srcWb = Workbooks.Open( _
                    folderPath & srcFile, _
                    ReadOnly:=True, UpdateLinks:=False)
                For Each srcWs In srcWb.Worksheets
                    newName = "[" & Left(srcFile, _
                        InStrRev(srcFile, ".") - 1) & _
                        "] " & srcWs.Name
                    If Len(newName) > 31 Then
                        newName = Left(newName, 28) & "..."
                    End If
                    On Error Resume Next
                    srcWs.Copy After:=ThisWorkbook.Sheets( _
                        ThisWorkbook.Sheets.Count)
                    If Err.Number = 0 Then
                        On Error GoTo CleanUp
                        ThisWorkbook.Sheets( _
                            ThisWorkbook.Sheets.Count) _
                            .Name = DeduplicateName(newName)
                        ThisWorkbook.Sheets( _
                            ThisWorkbook.Sheets.Count) _
                            .Columns("A:A") _
                            .Insert Shift:=xlToRight
                        With ThisWorkbook.Sheets( _
                            ThisWorkbook.Sheets.Count)
                            .Cells(1, 1).Value = _
                                "Source-File"
                            .Cells(1, 1).Font.Bold = True
                            .Range("A2", .Cells( _
                                .Cells(.Rows.Count, 2) _
                                .End(xlUp).Row, 1)) _
                                .Value = srcFile
                        End With
                        sheetCount = sheetCount + 1
                    Else
                        skipCount = skipCount + 1
                        Err.Clear
                    End If
                    On Error GoTo CleanUp
                Next srcWs
                srcWb.Close SaveChanges:=False
                fileCount = fileCount + 1
                srcFile = Dir()
            Loop
            Exit Do
        End If
    Loop

    ' ── Report ────────────────────────────────────────
    If skipCount > 0 Then
        fileMsg = " (" & skipCount & " sheet(s) skipped)"
    End If
    MsgBox "Imported " & sheetCount & " sheet(s) from " & _
           fileCount & " file(s)." & fileMsg, _
           vbInformation, "Import Complete"

CleanUp:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    If Err.Number <> 0 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description, _
               vbCritical, "Macro Error"
    End If
End Sub

' ── Helper: ensure unique sheet name ──────────────────
Private Function DeduplicateName(ByVal baseName As String) _
         As String
    Dim ws As Worksheet
    Dim attempt As String
    Dim counter As Long
    Dim maxLen As Long

    maxLen = 31
    attempt = baseName
    counter = 1

    On Error Resume Next
    Do
        Set ws = ThisWorkbook.Sheets(attempt)
        If ws Is Nothing Then Exit Do
        counter = counter + 1
        ' Build "BaseNa... (2)" keeping under 31 chars
        attempt = Left(baseName, maxLen - 4 - Len(CStr(counter)))
        attempt = attempt & " (" & counter & ")"
    Loop
    On Error GoTo 0

    DeduplicateName = attempt
End Function

#How It Works

#The folder picker — zero typing, zero typos

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the folder containing workbooks to import"
    If .Show = -1 Then
        folderPath = .SelectedItems(1)
    Else
        MsgBox "Import cancelled.", vbInformation, "Cancelled"
        GoTo CleanUp
    End If
End With

The macro opens the native Windows folder picker dialog — the same one you use for File → Open. No need to type or paste a folder path. If the user clicks Cancel, the macro exits cleanly with a message instead of crashing on an empty path.

#Opening source workbooks read-only

Set srcWb = Workbooks.Open(folderPath & srcFile, _
                            ReadOnly:=True, UpdateLinks:=False)

ReadOnly:=True prevents the macro from locking anyone else out of the source files — critical if the client’s workbooks are on a shared network drive. UpdateLinks:=False skips the “This workbook contains links” prompt for every file, which would otherwise require a click for each of 12 workbooks.

#The 31-character sheet name limit

newName = "[" & Left(srcFile, _
    InStrRev(srcFile, ".") - 1) & "] " & srcWs.Name
If Len(newName) > 31 Then
    newName = Left(newName, 28) & "..."
End If

Excel sheet names cannot exceed 31 characters. The macro builds names like [Entity-A] Fixed Assets and truncates if necessary — adding ... as a visual signal that the name was cut. For workbooks with long filenames, this is the tradeoff between readability and technical limits.

The Left(srcFile, InStrRev(srcFile, ".") - 1) pattern strips the file extension so Entity-A.xlsx becomes Entity-A in the sheet name, not Entity-A.xlsx.

#Deduplication — what happens when two files both have a “TB” sheet

The DeduplicateName helper function checks if the target name already exists. If [Entity-A] TB is taken, it tries [Entity-A] TB (2), then (3), etc. This prevents a silent overwrite — Excel normally refuses to create a sheet with a duplicate name and raises an error. The deduplication loop handles this in advance.

Do
    Set ws = ThisWorkbook.Sheets(attempt)
    If ws Is Nothing Then Exit Do
    counter = counter + 1
    attempt = Left(baseName, maxLen - 4 - Len(CStr(counter)))
    attempt = attempt & " (" & counter & ")"
Loop

The counter suffix adjusts automatically — (2) takes 4 characters, (10) takes 5 characters. The base name is trimmed to fit the suffix within the 31-character limit.

#The Source-File column — permanent audit trail

ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) _
    .Columns("A:A").Insert Shift:=xlToRight
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) _
    .Cells(1, 1).Value = "Source-File"

After each sheet is copied, the macro inserts a new column A, titles it “Source-File”, and fills every populated row with the source workbook’s filename. Six months later, when the partner asks where a specific number came from, the answer is in the first column of every sheet.

The Range("A2", .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 1)) pattern fills the column down to the last used row — only populated rows, not the entire column. This keeps the file size reasonable for sheets with only 20 rows of data and 1,048,576 empty rows.

#Scanning both .xlsx and .xlsm

srcFile = Dir(folderPath & "*.xlsx")
If srcFile = "" Then srcFile = Dir(folderPath & "*.xlsm")

Dir() with a wildcard returns the first matching file. The macro scans for .xlsx first, then .xlsm. After processing all .xlsx files (via repeated Dir() calls with no argument), the loop switches to .xlsm and processes those. This handles the real-world scenario where entity workbooks might be saved in either format — regular workbooks (.xlsx) and macro-enabled ones (.xlsm) both get imported.

#The double Dir() loop pattern

This is the trickiest part of the VBA. Dir() is stateful — once you start iterating files with one wildcard pattern, you can’t switch mid-loop. The macro solves this by nesting a second Do While loop for the .xlsm files after the .xlsx loop exhausts. Each branch uses its own Dir() call, and the outer loop exits when both file types have been fully scanned.

#Adapt It

Import only .xlsx files (skip .xlsm). If your firm only uses non-macro workbooks, remove the second Dir() block and the .xlsm fallback:

srcFile = Dir(folderPath & "*.xlsx")
Do While srcFile <> ""
    ' ... import code ...
    srcFile = Dir()
Loop

Don’t add a Source-File column. Remove the column insertion block (everything from Columns("A:A").Insert through .Value = srcFile) if you don’t need the audit trail. The sheet arrives exactly as it was.

Import specific sheets only. Add a sheet-name filter to skip everything except a list of expected names:

Const IMPORT_SHEETS As String = "TB,Fixed Assets,Depreciation"
' Inside the import loop, after "For Each srcWs":
If InStr(1, IMPORT_SHEETS, srcWs.Name, vbTextCompare) = 0 Then
    GoTo NextSrcSheet
End If

Add a file count preview before importing. Insert this code after the initial Dir() scan to tell the user what they’re about to import:

Dim previewCount As Long
Dim previewFile As String
previewFile = Dir(folderPath & "*.xlsx")
Do While previewFile <> ""
    previewCount = previewCount + 1
    previewFile = Dir()
Loop
previewFile = Dir(folderPath & "*.xlsm")
Do While previewFile <> ""
    previewCount = previewCount + 1
    previewFile = Dir()
Loop
If MsgBox("Found " & previewCount & " file(s) in folder." & _
          vbCrLf & "Import them all?", _
          vbYesNo + vbQuestion) = vbNo Then GoTo CleanUp
' Then proceed with the actual import loop

Import into a brand-new workbook instead of the current one. Replace all references to ThisWorkbook with a new workbook:

Dim destWb As Workbook
Set destWb = Workbooks.Add
' Replace every "ThisWorkbook" with "destWb" in the import code

See also: Split Workbook by Sheet — the reverse operation. Export each sheet of a consolidation to its own file. For folder-level file management, pair with Timestamped Backup for safety before large import operations.

Download the master consolidation workbook with instructions (also includes entity workbooks in a subfolder for testing)

xlsx 12 KB