VBA实现多工作表数据合并至主表并添加来源工作表名

Hey there! Let’s get this data sorted out for you. I know you’ve got multiple worksheets each holding just an ID (Column A) and Name (Column B), and you want to roll all that into a master sheet with three columns: Source Sheet Name (Column A), ID (Column B), and Name (Column C). Sounds like your existing code was copying data but missing that critical source sheet name column, or maybe not handling ranges correctly. Let’s build a reliable solution from scratch.

Working VBA Code #

Here’s a tested script that does exactly what you need:

Sub MergeSheetsToMaster()
    Dim ws As Worksheet
    Dim masterWs As Worksheet
    Dim lastRow As Long
    Dim masterLastRow As Long
    Dim sourceDataRange As Range
    
    ' Set up the master sheet - create it if it doesn't exist
    On Error Resume Next
    Set masterWs = ThisWorkbook.Worksheets("Master")
    On Error GoTo 0
    
    If masterWs Is Nothing Then
        Set masterWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        masterWs.Name = "Master"
        ' Add headers to the master sheet
        masterWs.Range("A1:C1").Value = Array("Source Sheet", "ID", "Name")
        masterWs.Range("A1:C1").Font.Bold = True
    End If
    
    ' Loop through every worksheet in the workbook
    For Each ws In ThisWorkbook.Worksheets
        ' Skip the master sheet itself to avoid circular merging
        If ws.Name <> masterWs.Name Then
            ' Find the last row with data in the source sheet's Column A
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            
            ' Only process the sheet if it has actual data
            If lastRow >= 1 Then
                ' Adjust this to "A2:B" & lastRow if your source sheets have headers in row 1
                Set sourceDataRange = ws.Range("A1:B" & lastRow)
                
                ' Find the next empty row in the master sheet
                masterLastRow = masterWs.Cells(masterWs.Rows.Count, "A").End(xlUp).Row + 1
                
                ' Copy ID and Name data to master sheet's Columns B and C
                sourceDataRange.Copy Destination:=masterWs.Range("B" & masterLastRow)
                
                ' Fill Column A with the current source sheet's name for all copied rows
                masterWs.Range("A" & masterLastRow & ":A" & masterLastRow + lastRow - 1).Value = ws.Name
            End If
        End If
    Next ws
    
    ' Auto-fit columns for better readability
    masterWs.Columns("A:C").AutoFit
    
    MsgBox "Merge done! Check your Master sheet.", vbInformation
End Sub

Key Details to Note #

• Master Sheet Setup: The script checks if a "Master" sheet exists. If not, it creates one and adds bold headers for clarity.
• Skip the Master Sheet: We make sure we don’t try to merge the master sheet into itself—this is a common pitfall!
• Data Range Detection: Uses End(xlUp) to find the last row with data, so it never copies empty rows from your source sheets.
• Source Sheet Name Column: This is probably what your original code was missing! The script fills Column A of the master sheet with the name of the source worksheet for every row of data from that sheet.
• Header Adjustment: If your source sheets have their own headers (like "ID" in A1 and "Name" in B1), change the sourceDataRange line to ws.Range("A2:B" & lastRow) and adjust the name fill range to masterLastRow + lastRow - 2 (since we’re skipping the header row in the source).

Troubleshooting Tips #

• If you see duplicate headers in the master sheet, double-check that you’re using A2:B instead of A1:B for source sheets with headers.
• If some sheets aren’t being merged, verify their names don’t match "Master" (VBA’s comparison is case-insensitive, but it’s worth checking).
• If you get an error about empty sheets, the script already skips them—no need to worry about blank worksheets cluttering your master.

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