Excel VBA多工作表数据合并至Report表运行失败求助

原代码错误点 #

• 循环语句语法错误：For i = 1 to Worksheets.Count = 1 是无效语法，且循环内始终引用Worksheets(1)，永远只复制第一个工作表内容，不会遍历目标工作表
• 内置常量拼写错误：所有x1开头的常量（x1Down/x1TopRight/x1Up）中的字符是小写字母L不是数字1，且不存在xlTopRight这个内置常量
• 复制范围逻辑错误：没有明确限定仅复制A、B列，会把工作表所有有数据的列都复制
• 依赖Select/Selection操作，运行时如果工作表处于非激活状态极易报错

修正后可运行代码 #

Sub Consolidate()
    Dim i As Integer
    Dim wsSource As Worksheet
    Dim wsReport As Worksheet
    Dim lastRowSource As Long
    Dim lastRowReport As Long
    
    ' 初始化报表工作表
    Set wsReport = ThisWorkbook.Worksheets("Report")
    ' 清空报表原有数据（不需要可以删除下一行）
    wsReport.UsedRange.Clear
    
    ' 遍历Sheet1到Sheet8共8个工作表
    For i = 1 To 8
        Set wsSource = ThisWorkbook.Worksheets("Sheet" & i)
        ' 获取源工作表A列最后一行有数据的行号
        lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
        ' 跳过无数据的工作表
        If lastRowSource >= 1 Then
            ' 获取报表工作表A列最后一个空行位置
            lastRowReport = wsReport.Cells(wsReport.Rows.Count, "A").End(xlUp).Row + 1
            ' 直接复制A、B列数据，无需选择操作
            wsSource.Range("A1:B" & lastRowSource).Copy wsReport.Range("A" & lastRowReport)
        End If
    Next i
    
    ' 清空剪贴板
    Application.CutCopyMode = False
    MsgBox "数据合并完成", vbInformation
End Sub

注意事项 #

• 确保工作簿中已提前创建名为Report的工作表
• 确保工作簿中确实存在Sheet1到Sheet8共8个名称完全匹配的工作表
• 如果需要保留Report表原有数据，删除代码中wsReport.UsedRange.Clear这一行即可

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