需求：编写VBA代码将多工作簿合并至当前工作簿单个工作表

Hey there, I’ve put together a VBA script that checks all your boxes—let’s dive in! This code lets you select multiple workbooks (each with only one sheet, matching headers), merges all their data into a single sheet in your current workbook, keeps just one header row, and stacks data seamlessly with no empty rows or gaps.

Full VBA Code #

Sub MergeMultipleWorkbooks()
    Dim fd As FileDialog
    Dim selectedFiles As Variant
    Dim wb As Workbook
    Dim destSheet As Worksheet
    Dim lastRow As Long
    Dim sourceData As Range
    Dim i As Integer
    
    ' Set destination sheet to the active sheet in current workbook
    Set destSheet = ThisWorkbook.ActiveSheet
    
    ' Clear existing data (optional—uncomment if you want a fresh start)
    ' destSheet.Cells.Clear
    
    ' Open file picker dialog to select multiple workbooks
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .AllowMultiSelect = True
        .Title = "Select Workbooks to Merge"
        .Filters.Add "Excel Files", "*.xlsx; *.xls; *.xlsm"
        If .Show = -1 Then
            selectedFiles = .SelectedItems
        Else
            MsgBox "No files selected. Exiting procedure.", vbInformation
            Exit Sub
        End If
    End With
    
    ' Turn off screen updating to speed up the process
    Application.ScreenUpdating = False
    
    ' Loop through each selected workbook
    For i = LBound(selectedFiles) To UBound(selectedFiles)
        ' Open the workbook
        Set wb = Workbooks.Open(selectedFiles(i))
        
        ' Define the source data range (used range of the first sheet)
        Set sourceData = wb.Sheets(1).UsedRange
        
        ' For the first workbook, copy header + all data
        If i = LBound(selectedFiles) Then
            sourceData.Copy destSheet.Cells(1, 1)
        Else
            ' For subsequent workbooks, copy only data (skip header row)
            sourceData.Offset(1, 0).Copy destSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If
        
        ' Close the source workbook without saving changes
        wb.Close SaveChanges:=False
    Next i
    
    ' Turn screen updating back on
    Application.ScreenUpdating = True
    
    MsgBox "Merge completed successfully!", vbInformation
End Sub

Key Details & How It Works #

• File Selection: Uses Application.FileDialog to let you pick multiple Excel files, filtering for common Excel formats.
• Header Handling: Only copies the header row from the first selected workbook—all subsequent workbooks skip their header and paste data directly below the last row of existing merged data.
• Seamless Pasting: Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) finds the first empty row below your merged data, ensuring no gaps or empty rows.
• Performance: Disables ScreenUpdating during the merge to make the process faster and avoid flickering.
• Safe Source Handling: Closes all source workbooks without saving changes, so your original files stay untouched.

Notes to Keep in Mind #

• Make sure all source workbooks have exactly one worksheet (the code uses the first sheet by default, which aligns with your requirement).
• Double-check that all headers are identical across workbooks—mismatched headers will cause data to misalign.
• It’s a good idea to back up your destination workbook before running the script, just to be safe!

内容的提问来源于stack exchange，提问作者harsha kazama