VBA跨表复制非相邻列粘贴提示区域大小不一致报错求解

问题背景 #

宏预期实现功能：

• 在Share Registry Transactions工作表内依次完成：指定区域单元格取消合并、删除前2行无效行、D列填充WORKDAY工作日计算公式
• 选取该表指定非相邻列的所有含数据行，复制粘贴到Daily Recon工作表的首个空行
  运行时触发报错：

You can't paste this here because the Copy and paste area aren't the same size
（无法在此粘贴，复制区域与粘贴区域大小不一致）

原问题代码如下：

Sub Macro2()
'
' Macro2 Macro
 
    Sheets("Share Registry Transactions").Select
    Range("A1:AA2").EntireRow.Select
    Selection.UnMerge
    Rows("1:2").Select
    Selection.Delete Shift:=xlUp
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=WORKDAY(RC[-1],3)"
    Range("D1").Select
    Selection.Copy
    Range("D2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A2:A4,C2").Select
    Range("C2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range("A2:A4,C2:C4,D2").Select
    Range("D2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range("A2:A4,C2:C4,D2:D4,E2").Select
    Range("E2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range("A2:A4,C2:C4,D2:D4,E2:E4,G2").Select
    Range("G2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range("A2:A4,C2:C4,D2:D4,E2:E4,G2:G4,H2").Select
    Range("H2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range("A2:A4,C2:C4,D2:D4,E2:E4,G2:G4,H2:H4,I2").Select
    Range("I2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range("A2:A4,C2:C4,D2:D4,E2:E4,G2:G4,H2:H4,I2:I4,J2").Select
    Range("J2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range("A2:A4,C2:C4,D2:D4,E2:E4,G2:G4,H2:H4,I2:I4,J2:J4,L2").Select
    Range("L2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Range("A2:A4,C2:C4,D2:D4,E2:E4,G2:G4,H2:H4,I2:I4,J2:J4,L2:L4,M2").Select
    Range("M2").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Daily Recon").Select
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveSheet.Paste
End Sub

根因分析 #

这段代码是Excel宏录制器生成的，存在3个核心问题导致报错：

• 非连续区域选择逻辑完全失效：逐列加选时，录制器只会固定记录屏幕上可见的前3行区域（即代码里反复出现的A2:A4、C2:C4这类固定范围），直接覆盖了之前选中的全量数据行，最终复制的是零散、尺寸不规则的单元格块，不是完整的所有数据行对应列。
• 强依赖Select/Activate选择操作：所有操作都基于当前选中的单元格执行，只要工作表激活状态、数据行数和录制时的测试场景不一致，就会出现区域定位偏差。
• 非连续区域粘贴规则不匹配：Excel复制多块不连续单元格时，要求粘贴目标的总行列尺寸和复制区域的组合尺寸完全一致，不规则的零散复制区域自然无法匹配单个起始单元格的粘贴要求。

修正方案 #

完全移除Select/Activate的依赖，直接通过工作表对象定位数据范围，明确指定需要复制的列，逐列映射粘贴到目标表对应位置，避免区域尺寸不匹配问题。修正后代码如下：

Sub FixedMacro()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastSourceRow As Long, targetStartRow As Long
    Dim copyCols As Variant, i As Long
    
    ' 绑定工作表对象
    Set wsSource = ThisWorkbook.Worksheets("Share Registry Transactions")
    Set wsTarget = ThisWorkbook.Worksheets("Daily Recon")
    
    ' 关闭屏幕更新提升运行速度
    Application.ScreenUpdating = False
    
    With wsSource
        ' 1. 取消前2行单元格合并
        .Range("A1:AA2").EntireRow.UnMerge
        ' 2. 删除前2行无效行
        .Rows("1:2").Delete Shift:=xlUp
        ' 3. 定位C列最后一行数据，填充D列工作日公式
        lastSourceRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        .Range("D1").FormulaR1C1 = "=WORKDAY(RC[-1],3)"
        .Range("D1:D" & lastSourceRow).FillDown
        ' 重新定位A列最后一行（确认全表数据行数）
        lastSourceRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    ' 定位目标表首个空行
    targetStartRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1
    
    ' 指定需要复制的源表列，按连续粘贴顺序排列：A、C、D、E、G、H、I、J、L、M
    copyCols = Array("A", "C", "D", "E", "G", "H", "I", "J", "L", "M")
    
    ' 逐列复制，直接粘贴值和格式到目标表对应列，避免非连续区域复制报错
    For i = LBound(copyCols) To UBound(copyCols)
        wsSource.Range(copyCols(i) & "2:" & copyCols(i) & lastSourceRow).Copy
        wsTarget.Cells(targetStartRow, i + 1).PasteSpecial Paste:=xlPasteAll
    Next i
    
    ' 清空剪贴板，恢复屏幕更新
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

可选调整 #

如果需要保留源表的原始列位置（即跳过的B、F、K列在粘贴后保留空白），可以将逐列复制的循环代码替换为以下内容：

' 保留原列位置的复制逻辑
For Each col In Array("A", "C", "D", "E", "G", "H", "I", "J", "L", "M")
    wsSource.Range(col & "2:" & col & lastSourceRow).Copy
    wsTarget.Range(col & targetStartRow).PasteSpecial Paste:=xlPasteAll
Next

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