跨工作簿将表格数据复制至含额外列的空表格问题求助

现有两个Excel工作簿：一个为数据源工作簿，另一个为模板工作簿（运行代码后会另存为副本）。需求是将数据源工作簿中某表格的数据，复制到模板副本内结构类似但包含额外列的空表格（该表格仅含1行空行）。

初始代码如下：

Set chWb = Excel.Workbooks.Open(LinkToDataSource)
Set sht = chWb.Worksheets(SheetWithTable)
Set tbl = sht.ListObjects(TableWeWantToCopyFrom)
' 引用目标表格
Set checkTbl = SheetName.ListObjects(TableWeWantToPasteInto)

尝试方法1及报错：

' 选择并复制数据
tbl.DataBodyRange.Select.Copy
' 粘贴值
checkTbl.DataBodyRange.PasteSpecial xlPasteValues

运行时抛出错误91：Object variable or with block not set，原因是目标表格仅含1行空行时，checkTbl.DataBodyRange会返回Nothing，无法执行粘贴操作。

尝试添加行的代码及报错：

checkTbl.RowList.Add(tbl.ListRows.Count)

直接抛出错误：Subscript out of range，原因是RowList并非ListObject的合法属性，属于API误用。

1. 修正目标表格的引用逻辑 #

确保SheetName是模板副本中工作表的有效引用：如果是字符串名称，需改为ThisWorkbook.Worksheets("你的工作表名")的形式，避免使用未定义的变量直接引用。

2. 正确处理目标表格的行空间 #

先清空目标表格的空行，再根据数据源行数批量添加对应数量的行：

' 删除目标表格的空行（若不需要保留）
If Not checkTbl.DataBodyRange Is Nothing Then
    checkTbl.DataBodyRange.Delete
End If

' 计算需要添加的行数并批量新增
Dim addRowsCount As Integer
addRowsCount = tbl.ListRows.Count
If addRowsCount > 0 Then
    checkTbl.ListRows.Add Count:=addRowsCount
End If

3. 优化复制粘贴逻辑（避免使用Select） #

直接操作单元格区域，提升代码稳定性：

' 复制数据源的值到目标表格
tbl.DataBodyRange.Copy
checkTbl.DataBodyRange.PasteSpecial Paste:=xlPasteValues
' 清除剪贴板，释放资源
Application.CutCopyMode = False

Sub CopyTableData()
    Dim chWb As Workbook
    Dim sht As Worksheet
    Dim tbl As ListObject
    Dim checkTbl As ListObject
    Dim addRowsCount As Integer
    
    ' 打开数据源工作簿
    Set chWb = Excel.Workbooks.Open(LinkToDataSource)
    ' 引用数据源工作表与表格
    Set sht = chWb.Worksheets(SheetWithTable)
    Set tbl = sht.ListObjects(TableWeWantToCopyFrom)
    
    ' 引用模板副本的目标表格（替换为实际工作表名称）
    Set checkTbl = ThisWorkbook.Worksheets("模板工作表名").ListObjects(TableWeWantToPasteInto)
    
    ' 清空目标表格现有数据行
    If Not checkTbl.DataBodyRange Is Nothing Then
        checkTbl.DataBodyRange.Delete
    End If
    
    ' 批量添加对应行数
    addRowsCount = tbl.ListRows.Count
    If addRowsCount > 0 Then
        checkTbl.ListRows.Add Count:=addRowsCount
    End If
    
    ' 复制粘贴值
    tbl.DataBodyRange.Copy
    checkTbl.DataBodyRange.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    ' 关闭数据源工作簿（按需选择是否保存）
    chWb.Close SaveChanges:=False
End Sub

• 避免使用Select/Activate：直接操作对象是VBA的最佳实践，能大幅降低报错概率。
• 空表格的DataBodyRange判断：当表格只有表头或空行时，DataBodyRange会返回Nothing，必须先判断再执行后续操作。
• 正确新增行的方法：ListObject新增行需用ListRows.Add，通过Count参数可批量添加多行，不要使用不存在的RowList属性。

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