VBA跨表调用PasteSpecial粘贴触发运行时错误1004求助

核心报错原因 #

• 运行时错误1004（尺寸不匹配）：原代码定义Devices区域时用Range("H2").End(xlDown)写法，当H列从H2开始仅1行有效数据时，End(xlDown)会直接定位到工作表最后一行（1048576行），选中的复制区域是数十万行的无效空区域，和目标粘贴区域大小差几个数量级，必然触发报错。
• PasteSpecial xlPasteValues无法使用：原代码全程依赖Select选中单元格后调用工作表级别的Paste方法，这种写法本身对PasteSpecial的参数兼容性极差，再加上复制区域本身选的不对，自然无法正常执行值粘贴。
• 原代码附带的隐性bug：用VBA内置函数名Date作为自定义变量名、最后粘贴日期时调用了未定义的Paiva变量、逐行循环粘贴+反复激活工作表的写法效率极低、用Integer类型存行号容易触发数据溢出。

修正后完整代码 #

Sub 跨工作表数据整合()
    Dim Lastrow As Long
    Dim OrderNr As Range
    Dim Customer As Range
    Dim OrderDate As Range
    Dim Devices As Range
    Dim DeviceAmount As Long
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim hLastRow As Long, hLastCol As Long

    ' 直接绑定源表和目标表，无需反复激活切换工作表
    Set wsSource = ThisWorkbook.Worksheets("Laskentapohja")
    Set wsTarget = ThisWorkbook.Worksheets("Tilauslistaus")

    ' 绑定源表固定取值单元格
    Set Customer = wsSource.Range("A4")
    Set OrderNr = wsSource.Range("C5")
    Set OrderDate = wsSource.Range("E5")

    ' 精准计算Devices有效区域，兼容1行数据的场景
    hLastRow = wsSource.Cells(wsSource.Rows.Count, "H").End(xlUp).Row
    hLastCol = wsSource.Cells(2, wsSource.Columns.Count).End(xlToLeft).Column
    If hLastRow < 2 Then hLastRow = 2 ' 处理H列仅H2有值的极端情况
    Set Devices = wsSource.Range(wsSource.Cells(2, "H"), wsSource.Cells(hLastRow, hLastCol))

    DeviceAmount = hLastRow - 1
    MsgBox "Amount of devices is " & DeviceAmount

    ' 粘贴Devices区域到目标表F列：直接值赋值，完全绕开剪贴板，等价于xlPasteValues，无尺寸匹配问题
    Lastrow = wsTarget.Cells(wsTarget.Rows.Count, "F").End(xlUp).Row + 1
    wsTarget.Range("F" & Lastrow).Resize(Devices.Rows.Count, Devices.Columns.Count).Value = Devices.Value

    ' 一次性批量写入客户名、订单号、日期，无需逐行循环粘贴
    wsTarget.Range("A" & Lastrow).Resize(DeviceAmount, 1).Value = Customer.Value
    wsTarget.Range("B" & Lastrow).Resize(DeviceAmount, 1).Value = OrderNr.Value
    wsTarget.Range("C" & Lastrow).Resize(DeviceAmount, 1).Value = OrderDate.Value
End Sub

关键修改点说明 #

• 弃用所有Select/Activate+剪贴板复制粘贴的逻辑：跨表传值直接通过区域Value属性对等赋值，运行效率比原生复制粘贴高一个量级，彻底解决复制/粘贴区域尺寸不匹配、PasteSpecial无法调用的问题。
• 重构Devices区域的选择逻辑：改为从工作表底部向上查找最后一行有效数据的写法，无论有效数据是1行还是上千行，都能精准选中目标区域，不会出现选到整列空行的问题。
• 修复所有隐性bug：将和VBA内置函数重名的变量重命名，修正未定义变量的调用问题，将存储行号的变量类型从Integer改为Long避免溢出，用Resize方法一次性批量写入重复值，去掉冗余的逐行循环逻辑。

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