跨Excel工作簿非对应列数据复制的高效方法求解

你的原代码依赖Activate、Select操作，不仅运行效率低，还容易因窗口切换出错，针对20多列非对应转移的场景，推荐以下几种高效方案：

方案1：直接单元格区域赋值（最快，仅转值） #

跳过剪贴板，直接将源区域的值写入目标区域，这是VBA中处理数据转移最快的方式，无需激活任何工作簿/工作表：

' 先定义源、目标工作表对象（替换成你的实际工作表名称）
Dim wsSource As Worksheet, wsTarget As Worksheet
Set wsSource = wkbk1.Sheets("源工作表")
Set wsTarget = wkbk2.Sheets("目标工作表")

' 假设lr是你已获取的源数据最后行号
' 示例：源col1列 → 目标C列
wsTarget.Range("C2:C" & lr).Value = wsSource.Range(wsSource.Cells(2, col1), wsSource.Cells(lr, col1)).Value
' 源col2列 → 目标E列
wsTarget.Range("E2:E" & lr).Value = wsSource.Range(wsSource.Cells(2, col2), wsSource.Cells(lr, col2)).Value
' 依此类推，添加其他列的对应赋值语句

方案2：数组批量读写（适合大量列，效率拉满） #

把所有需要的源数据一次性读到内存数组中，再按对应关系写入目标列，大幅减少与Excel界面的交互次数，处理海量数据时优势明显：

Dim wsSource As Worksheet, wsTarget As Worksheet
Dim sourceData As Variant
Dim lr As Long

Set wsSource = wkbk1.Sheets("源工作表")
Set wsTarget = wkbk2.Sheets("目标工作表")
' 取源数据最后行号（以col1列为例，可替换为其他有数据的列）
lr = wsSource.Cells(wsSource.Rows.Count, col1).End(xlUp).Row

' 读取需要的源列到数组（示例：读取col1、col3、col5三列）
sourceData = wsSource.Range(wsSource.Cells(2, col1), wsSource.Cells(lr, col5)).Value

' 按对应关系写入目标列
' 源数组第1列（对应col1）→ 目标C列
wsTarget.Range("C2:C" & lr).Value = Application.Index(sourceData, 0, 1)
' 源数组第3列（对应col3）→ 目标E列
wsTarget.Range("E2:E" & lr).Value = Application.Index(sourceData, 0, 3)
' 源数组第5列（对应col5）→ 目标G列
wsTarget.Range("G2:G" & lr).Value = Application.Index(sourceData, 0, 5)

方案3：带格式的快速复制（需保留格式/公式时用） #

如果需要复制单元格格式、公式、批注等内容，不用激活窗口，直接用Copy方法指定目标区域即可：

Dim wsSource As Worksheet, wsTarget As Worksheet
Set wsSource = wkbk1.Sheets("源工作表")
Set wsTarget = wkbk2.Sheets("目标工作表")

' 源col1列复制到目标C列，保留所有格式和公式
wsSource.Range(wsSource.Cells(2, col1), wsSource.Cells(lr, col1)).Copy Destination:=wsTarget.Range("C2")
' 源col2列复制到目标E列
wsSource.Range(wsSource.Cells(2, col2), wsSource.Cells(lr, col2)).Copy Destination:=wsTarget.Range("E2")

注意事项 #

• 所有方案都避免了Activate和Select操作，代码更稳定、运行更快；
• 优先使用方案1或方案2处理纯数据转移，速度比复制粘贴快数倍；
• 若需保留格式等附加信息，再使用方案3。

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