如何修改VBA代码将多Excel文件内容合并到同一工作表

Got it, let's sort this out for you. Your original code is spawning new worksheets for every sheet in each target file, but we need to append all that data into one single worksheet in the workbook where you're running the macro. Here's the adjusted code, plus a breakdown of the key changes:

Sub MergeAllFilesIntoSingleSheet()
    Dim myPath As String, myFile As String
    Dim targetWs As Worksheet
    Dim sourceWb As Workbook, sourceWs As Worksheet
    Dim lastTargetRow As Long, lastSourceRow As Long, lastSourceCol As Long
    Dim firstFile As Boolean
    
    ' Set your target folder path
    myPath = "C:\Users\xxxx\Desktop\test macro\"
    ' Set the worksheet you want to merge INTO (change "Sheet1" to your actual sheet name)
    Set targetWs = ThisWorkbook.Sheets("Sheet1")
    firstFile = True ' Flag to keep only the first header row
    
    ' Speed up macro by disabling screen updates
    Application.ScreenUpdating = False
    
    myFile = Dir(myPath & "*.xlsx")
    
    Do While myFile <> ""
        ' Open the source workbook
        Set sourceWb = Workbooks.Open(myPath & myFile)
        
        ' Loop through each worksheet in the source file
        For Each sourceWs In sourceWb.Worksheets
            ' Find the last row/column with data in the source sheet
            lastSourceRow = sourceWs.Cells(sourceWs.Rows.Count, "A").End(xlUp).Row
            lastSourceCol = sourceWs.Cells(1, sourceWs.Columns.Count).End(xlToLeft).Column
            
            ' Skip empty sheets to avoid errors
            If lastSourceRow >= 1 And lastSourceCol >= 1 Then
                ' Find the next empty row in the target sheet
                lastTargetRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row
                
                If firstFile Then
                    ' Copy full data (including header) for the first file
                    sourceWs.Range(sourceWs.Cells(1, 1), sourceWs.Cells(lastSourceRow, lastSourceCol)).Copy _
                        Destination:=targetWs.Cells(lastTargetRow + 1, 1)
                    firstFile = False
                Else
                    ' Skip header for subsequent files (start from row 2)
                    sourceWs.Range(sourceWs.Cells(2, 1), sourceWs.Cells(lastSourceRow, lastSourceCol)).Copy _
                        Destination:=targetWs.Cells(lastTargetRow + 1, 1)
                End If
            End If
        Next sourceWs
        
        ' Close source workbook without saving changes (avoids popups)
        sourceWb.Close SaveChanges:=False
        ' Grab the next file in the folder
        myFile = Dir
    Loop
    
    ' Re-enable screen updates
    Application.ScreenUpdating = True
    MsgBox "Merge complete!", vbInformation
End Sub

Key Changes Explained: #

• Explicit Target Sheet: We define targetWs to point directly to the sheet you want all data merged into (don't forget to rename "Sheet1" to your actual sheet name).
• Header Handling: The firstFile flag ensures we only keep one header row in your merged sheet, so you don't end up with duplicate headers from every file.
• Dynamic Range Detection: We calculate the last used row/column in both source and target sheets to avoid copying empty cells and paste data in the correct position every time.
• Performance Boost: Disabling ScreenUpdating cuts down on lag, especially if you're merging dozens of files.
• Clean File Closure: sourceWb.Close SaveChanges:=False stops annoying popups asking to save edits to the source files we opened.

Quick Notes: #

• If your source files have mismatched column structures, you'll want to add checks (like verifying column headers match) before merging to avoid messy data.
• If you do want to keep headers from every sheet (unusual, but possible), just remove the firstFile flag logic and copy all rows for every file.

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