如何将数据粘贴到另一个Workbook最后空白行？VBA报错及优化求助

我知道网上有无数类似问题，但现有答案都无法解决我的问题。我需要将一个工作簿中的数据复制到另一个工作簿，要求粘贴到最后已填充行的下一行。

我的场景：

• Workbook1（数据源）：表格数据分布在A、B、C、D、E、F、G、I列
• Workbook2（目标）：已随机填充部分测试数据，需按指定列映射粘贴数据

我尝试了以下VBA代码，但出现1004: 应用程序定义或对象定义错误。作为VBA新手，我不清楚问题出在哪。另外，代码里我在目标工作簿重排了列，请问有没有办法让代码更规整？

Sub copying()
Application.ScreenUpdating = False
    
Workbooks.Open "C:\Users\est_acpinheiro\Desktop\pypdf\table.xlsx"
Workbooks.Open "C:\Users\est_acpinheiro\Desktop\pypdf\exporting.xlsx"

Workbooks("table.xlsx").Worksheets("Sheet1").Range("A:A").Copy _
Workbooks("exporting.xlsx").Worksheets("Plan1").Range("E:E" & Rows.Count).End(xlUp).Offset(1, 0) 'A-E

Workbooks("table.xlsx").Worksheets("Sheet1").Range("B:B").Copy _
Workbooks("exporting.xlsx").Worksheets("Plan1").Range("G:G" & Rows.Count).End(xlUp).Offset(1, 0)  'B-G

Workbooks("table.xlsx").Worksheets("Sheet1").Range("C:C").Copy _
Workbooks("exporting.xlsx").Worksheets("Plan1").Range("A:A" & Rows.Count).End(xlUp).Offset(1, 0)  'C-A
   
Workbooks("table.xlsx").Worksheets("Sheet1").Range("D:D").Copy _
Workbooks("exporting.xlsx").Worksheets("Plan1").Range("C:C" & Rows.Count).End(xlUp).Offset(1, 0)  'D-C
 
Workbooks("table.xlsx").Worksheets("Sheet1").Range("E:E").Copy _
Workbooks("exporting.xlsx").Worksheets("Plan1").Range("B:B" & Rows.Count).End(xlUp).Offset(1, 0)  'E-B

Workbooks("table.xlsx").Worksheets("Sheet1").Range("F:F").Copy _
Workbooks("exporting.xlsx").Worksheets("Plan1").Range("I:I" & Rows.Count).End(xlUp).Offset(1, 0)  'F-I

Workbooks("table.xlsx").Worksheets("Sheet1").Range("G:G").Copy _
Workbooks("exporting.xlsx").Worksheets("Plan1").Range("K:K" & Rows.Count).End(xlUp).Offset(1, 0)  'G-K

Workbooks("table.xlsx").Worksheets("Sheet1").Range("I:I").Copy _
Workbooks("exporting.xlsx").Worksheets("Plan1").Range("H:H" & Rows.Count).End(xlUp).Offset(1, 0)  'I-H

Application.CutCopyMode = False

End Sub

一、报错原因及修复 #

1004错误的核心是目标单元格的Range写法非法：你写的Range("E:E" & Rows.Count)是错误拼接，正确逻辑应该是先定位列的最后一行，再获取目标单元格，比如Range("E" & Rows.Count).End(xlUp).Offset(1,0)。

另外，直接引用Workbooks("xxx")容易因文件名变更、未激活等问题出错，建议用变量存储工作簿/工作表对象，让代码更稳定。

二、优化后的代码 #

下面的代码解决了报错问题，同时做了结构化优化：

• 用变量存储工作簿/工作表，减少重复代码
• 定义列映射数组，后续改列对应关系只需调整数组
• 只复制有数据的行，避免复制整列空值，提升效率
• 保留屏幕刷新关闭，提升运行速度

Sub CopyDataWithMapping()
    Application.ScreenUpdating = False
    Dim wbSource As Workbook, wbTarget As Workbook
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRowSource As Long, lastRowTarget As Long
    Dim colMapping As Variant
    Dim i As Integer
    
    ' 定义列映射：[数据源列, 目标列]
    colMapping = Array( _
        Array("A", "E"), _
        Array("B", "G"), _
        Array("C", "A"), _
        Array("D", "C"), _
        Array("E", "B"), _
        Array("F", "I"), _
        Array("G", "K"), _
        Array("I", "H") _
    )
    
    ' 打开工作簿并绑定工作表对象
    Set wbSource = Workbooks.Open("C:\Users\est_acpinheiro\Desktop\pypdf\table.xlsx")
    Set wbTarget = Workbooks.Open("C:\Users\est_acpinheiro\Desktop\pypdf\exporting.xlsx")
    Set wsSource = wbSource.Worksheets("Sheet1")
    Set wsTarget = wbTarget.Worksheets("Plan1")
    
    ' 获取数据源的最后有效行（避免复制空行）
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历列映射完成复制
    For i = LBound(colMapping) To UBound(colMapping)
        ' 获取目标列的下一个空白行
        lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, colMapping(i)(1)).End(xlUp).Offset(1, 0).Row
        ' 复制对应列的有效数据到目标位置
        wsSource.Range(colMapping(i)(0) & "1:" & colMapping(i)(0) & lastRowSource).Copy _
            wsTarget.Range(colMapping(i)(1) & lastRowTarget)
    Next i
    
    ' 清理剪贴板并恢复屏幕刷新
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    ' 可选：保存目标文件并关闭源文件
    ' wbTarget.Save
    ' wbSource.Close SaveChanges:=False
End Sub

三、关键说明 #

1. 列映射数组：后续调整列对应关系时，只需修改colMapping数组，无需改动复制逻辑，维护更方便
2. 有效行复制：通过lastRowSource获取数据源的最后一行，避免复制整列的大量空单元格，提升运行效率
3. 对象变量引用：用wbSource、wsTarget等变量替代重复的文件/表名引用，减少代码冗余，同时避免因名称变更导致的错误

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