如何将特定命名格式的Excel工作表合并至汇总表？

Sub MergeScoreSheets()
    Dim wsMaster As Worksheet
    Dim ws As Worksheet
    Dim RowTracker As Long
    Dim LastRow As Long
    Dim LastColumn As Long
    
    ' 定位汇总表
    Set wsMaster = ThisWorkbook.Worksheets("XXX_SCORE_TOTAL")
    RowTracker = 2 ' 从第2行开始粘贴（假设第1行是表头）
    
    ' 遍历工作簿所有工作表
    For Each ws In ThisWorkbook.Worksheets
        ' 筛选条件：不是汇总表，且名称以"X_Score_"开头（匹配你要的日期格式前缀）
        If ws.Name <> "XXX_SCORE_TOTAL" And Left(ws.Name, 8) = "X_Score_" Then
            ' 获取当前工作表的有效数据行数和列数
            LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            LastColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
            
            ' 仅当工作表有数据（第2行及以后）时执行复制
            If LastRow >= 2 Then
                ws.Range(ws.Cells(2, 1), ws.Cells(LastRow, LastColumn)).Copy _
                    wsMaster.Cells(RowTracker, 1)
                ' 更新下一次粘贴的起始行（复制的行数是LastRow-1，因为从第2行开始）
                RowTracker = RowTracker + (LastRow - 1)
            End If
        End If
    Next ws
    
    MsgBox "合并完成！", vbInformation
End Sub

• 精准筛选目标工作表：通过Left(ws.Name, 8) = "X_Score_"锁定符合X_Score_日期格式的表，同时排除汇总表，避免遍历所有工作表导致的混乱。
• 修复行号计算错误：原代码中RowTracker = RowTracker + LastRow会导致汇总表出现大量空行，改为RowTracker = RowTracker + (LastRow - 1)，因为复制的是从第2行到LastRow的内容，实际行数为LastRow-1。
• 增加空表判断：如果工作表只有表头（LastRow=1），直接跳过复制，防止报错。
• 统一工作簿引用：替换原代码中混用的ThisWorkbook和ActiveWorkbook，确保操作的是代码所在的目标工作簿。

你直接Set MyCollection = ThisWorkbook.Worksheets("X_Score_" & CurrentDate)无法生效，因为Worksheets集合不能直接通过动态名称批量筛选。如果想用集合管理目标表，需要先创建集合对象，再手动添加符合条件的工作表，示例如下：

Sub UseCollectionForMerge()
    Dim scoreSheets As New Collection
    Dim ws As Worksheet
    Dim wsMaster As Worksheet
    Dim RowTracker As Long
    Dim LastRow As Long
    Dim LastColumn As Long
    
    Set wsMaster = ThisWorkbook.Worksheets("XXX_SCORE_TOTAL")
    RowTracker = 2
    
    ' 将符合条件的工作表加入集合
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "XXX_SCORE_TOTAL" And Left(ws.Name, 8) = "X_Score_" Then
            scoreSheets.Add ws
        End If
    Next ws
    
    ' 遍历集合完成合并
    For Each ws In scoreSheets
        LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        LastColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        If LastRow >= 2 Then
            ws.Range(ws.Cells(2, 1), ws.Cells(LastRow, LastColumn)).Copy _
                wsMaster.Cells(RowTracker, 1)
            RowTracker = RowTracker + (LastRow - 1)
        End If
    Next ws
    
    MsgBox "合并完成！", vbInformation
End Sub

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