如何遍历工作表列表并将数据批量复制到主工作表？

我来给你整理两个清晰的实现方案，刚好对应你尝试过的两种思路——用数组存工作表名遍历，或者遍历工作表名称列表，帮你把数据合并到主工作表里：

这种方法特别适合你这种工作表按数字（1、2、3……200）命名的场景，我们可以动态生成工作表名数组，不用手动输入200个名字，效率很高。这里我会修正你代码里的小问题（比如字符串不能直接调用Range方法、循环结构混乱），给出完整可运行的示例：

Sub CopyDataFromSheets_Array()
    Dim wsMaster As Worksheet
    Dim ws As Worksheet
    Dim sheetNames As Variant
    Dim element As Variant
    Dim nextRow As Long ' 记录主表中下一个要粘贴数据的行号
    Dim i As Integer
    
    ' 初始化主工作表，把"Master"改成你实际的主表名称
    Set wsMaster = ThisWorkbook.Worksheets("Master")
    ' 获取主表最后一行有数据的行，从下一行开始粘贴，避免覆盖已有内容
    nextRow = wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp).Row + 1
    
    ' 动态生成1到200的工作表名数组
    ReDim sheetNames(1 To 200)
    For i = 1 To 200
        sheetNames(i) = CStr(i) ' 把数字转成字符串作为工作表名
    Next i
    
    ' 遍历数组中的每个工作表
    For Each element In sheetNames
        ' 先判断工作表是否存在，防止因表名错误报错
        On Error Resume Next
        Set ws = ThisWorkbook.Worksheets(element)
        On Error GoTo 0
        
        If Not ws Is Nothing Then
            ' 检查当前工作表的C3单元格是否为空（和你代码里的逻辑一致）
            If ws.Range("C3").Value <> "" Then
                ' 示例：复制当前工作表A1:C10范围的数据，你可以改成自己需要的范围
                ws.Range("A1:C10").Copy
                ' 粘贴到主表的nextRow行、A列开始的位置，这里只粘贴值，按需可改
                wsMaster.Cells(nextRow, "A").PasteSpecial Paste:=xlPasteValues
                ' 更新下一个粘贴的行号
                nextRow = nextRow + ws.Range("A1:C10").Rows.Count
            End If
            Set ws = Nothing ' 释放对象，避免内存占用
        End If
    Next element
    
    Application.CutCopyMode = False ' 取消复制状态
    MsgBox "数据合并完成！", vbInformation
End Sub

关键说明： #

• 如果你的工作表不是全按1-200命名，也可以手动指定数组，比如sheetNames = Array("Sheet24", "Sheet25", "5")
• 加入了工作表存在性检查，避免因表名拼写错误或表不存在导致代码崩溃
• 可以根据需求修改复制范围（比如ws.Range("D5:F20")）和粘贴类型（比如xlPasteAll复制格式和公式）

如果你已经把要遍历的工作表名存在了某个工作表（比如名为"SheetList"的B列，从第11行开始），用这种方法更灵活，适合需要随时调整遍历列表的场景：

Sub CopyDataFromSheets_List()
    Dim wsMaster As Worksheet
    Dim wsList As Worksheet
    Dim ws As Worksheet
    Dim i As Integer
    Dim sheetName As String
    Dim nextRow As Long
    
    ' 初始化主表和存储名称列表的工作表
    Set wsMaster = ThisWorkbook.Worksheets("Master")
    Set wsList = ThisWorkbook.Worksheets("SheetList") ' 存储工作表名的表格所在工作表
    nextRow = wsMaster.Cells(wsMaster.Rows.Count, "A").End(xlUp).Row + 1
    
    i = 11 ' 从第11行开始遍历名称列表
    Do While wsList.Cells(i, "B").Value <> ""
        sheetName = wsList.Cells(i, "B").Value
        
        ' 检查工作表是否存在
        On Error Resume Next
        Set ws = ThisWorkbook.Worksheets(sheetName)
        On Error GoTo 0
        
        If Not ws Is Nothing Then
            If ws.Range("C3").Value <> "" Then
                ' 复制指定范围数据，按需修改
                ws.Range("A1:C10").Copy
                wsMaster.Cells(nextRow, "A").PasteSpecial xlPasteValues
                nextRow = nextRow + ws.Range("A1:C10").Rows.Count
            End If
            Set ws = Nothing
        Else
            ' 可选：如果表不存在，弹出提示
            MsgBox "工作表「" & sheetName & "」不存在，已跳过！", vbExclamation
        End If
        
        i = i + 1
    Loop
    
    Application.CutCopyMode = False
    MsgBox "数据合并完成！", vbInformation
End Sub

额外优化建议： #

如果要遍历200个工作表，建议在代码开头加上Application.ScreenUpdating = False，结尾加上Application.ScreenUpdating = True，可以大幅提升运行速度，避免屏幕频繁闪烁。

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