复制到其他工作表出错：VBA批量提取首个无表头表格至汇总表

我看你的代码没写完，而且报错“复制到其他工作表时出错”，大概率是数据范围定位不准确或者复制粘贴逻辑不完整导致的。下面我帮你修正代码，精准实现提取每个工作表的首个表格（不含表头）并汇总到"Table"工作表的需求：

修正后的完整代码 #

Sub TableCopy()
    Dim ws As Worksheet
    Dim targetWs As Worksheet
    Dim sourceTable As ListObject
    Dim targetLastRow As Long
    
    ' 关闭屏幕更新提升运行效率
    Application.ScreenUpdating = False
    
    ' 明确目标汇总工作表
    Set targetWs = ThisWorkbook.Worksheets("Table")
    
    ' 遍历工作簿内所有工作表
    For Each ws In ThisWorkbook.Worksheets
        ' 跳过汇总目标表本身
        If ws.Name <> targetWs.Name Then
            ' 检查当前工作表是否存在表格
            If ws.ListObjects.Count > 0 Then
                ' 获取当前工作表的首个表格
                Set sourceTable = ws.ListObjects(1)
                ' 确保表格有数据（避免空表格引发错误）
                If Not sourceTable.DataBodyRange Is Nothing Then
                    ' 定位目标表H列的最后一行数据位置
                    targetLastRow = targetWs.Range("H" & targetWs.Rows.Count).End(xlUp).Row
                    ' 处理目标表为空的特殊情况
                    If targetLastRow = 1 And targetWs.Range("H1").Value = "" Then
                        targetLastRow = 0
                    End If
                    ' 复制表格数据到目标表的下一行
                    sourceTable.DataBodyRange.Copy Destination:=targetWs.Range("H" & targetLastRow + 1)
                End If
            End If
        End If
    Next ws
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    MsgBox "表格汇总完成！", vbInformation
End Sub

关键修正点说明 #

• 用ListObject精准定位表格：Excel的表格（ListObject）自带DataBodyRange属性，直接指向不含表头的数据区域，比手动判断单元格范围更可靠，避免因表头行数、空行等问题定位出错。
• 完善目标行定位逻辑：增加了目标表为空的判断，避免复制到错误的起始行。
• 明确对象引用：用ThisWorkbook替代ActiveWorkbook，避免当前激活的工作簿不是目标工作簿导致的错误；同时明确每个工作表和表格的对象，减少隐式引用的问题。
• 增加错误防护：判断工作表是否有表格、表格是否有数据，避免空表格或无表格的工作表引发运行错误。

原代码可能的错误原因 #

1. 代码未完成：你提供的代码到LR1 = Sheets("Table").Range("H" & Rows.Count).En...就截断了，缺少后续的复制粘贴核心逻辑。
2. 数据范围判断错误：如果手动用单元格范围判断表格数据，很容易因为表头行数、空行等问题定位错误，导致复制时引用无效范围。
3. 隐式引用问题：比如Rows.Count未指定工作表，可能会引用当前激活工作表的行数，导致最后一行计算错误。

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