VBA跨工作簿匹配工作表复制数据 报溢出错误6解决方法

代码触发错误6「溢出」、运行不符合预期的核心问题如下：

• 表名、文件名拼写不匹配：需求说明中int_calculation.xlsx内对应表名格式为Corrected_Accruals-xxx（Accruals前为下划线），原代码写为带空格的Corrected Accruals；原代码中工作簿名写为首字母大写的int_Calculation.xlsx，部分Excel版本的工作簿集合为严格匹配，易触发下标找不到的错误。
• 最后一行查找逻辑不可靠：Range.Find方法未指定LookIn、LookAt参数时，会继承上一次用户在Excel查找对话框中的设置，极端场景下返回异常结果，若查找不到任何值直接取.Row属性，会触发运行时错误，部分场景下抛出溢出提示。
• 单元格引用写法错误：Cells属性需传入行号、列号两个参数，原代码中opsheet.Cells("A5")为单参数错误写法，VBA会隐式尝试将字符串"A5"转换为数值，类型转换失败时易触发异常。
• 缺少存在性校验：若reference表A列存在无效值、对应工作表尚未创建，直接为Worksheet对象赋值会直接中断运行。
• 循环范围写法错误：原代码中Range("A2: A" & lastRow)冒号后存在多余空格，部分Excel版本会识别为无效单元格范围。

Sub Copy_Data()
    Dim lastRow As Long
    Dim i As Range
    Dim opsheet As Worksheet
    Dim inputsheet As Worksheet
    Dim ip As Worksheet
    Dim wbRem As Workbook, wbInt As Workbook
    
    ' 绑定工作簿，规避名称匹配问题
    Set wbRem = Workbooks("remediation.xlsm")
    Set wbInt = Workbooks("int_calculation.xlsx")
    Set inputsheet = wbRem.Worksheets("reference")
    
    ' 固定Find参数，可靠获取A列最后一行行号
    lastRow = inputsheet.Columns("A").Find(What:="*", _
                                           LookIn:=xlValues, _
                                           LookAt:=xlPart, _
                                           SearchOrder:=xlByRows, _
                                           SearchDirection:=xlPrevious).Row
    
    ' 遍历A列ID，修正范围写法（移除冒号后多余空格）
    For Each i In inputsheet.Range("A2:A" & lastRow)
        ' 跳过空单元格
        If VBA.Trim(i.Value) <> "" Then
            ' 校验对应工作表是否存在，不存在则跳过避免中断
            On Error Resume Next
            Set ip = wbRem.Worksheets(CStr(i.Value))
            Set opsheet = wbInt.Worksheets("Corrected_Accruals-" & CStr(i.Value))
            On Error GoTo 0
            
            ' 两个匹配工作表都存在时才执行值复制
            If Not ip Is Nothing And Not opsheet Is Nothing Then
                opsheet.Range("A5") = ip.Range("A5").Value
                opsheet.Range("B5") = ip.Range("B5").Value
                opsheet.Range("D5") = ip.Range("D5").Value
                opsheet.Range("E5") = ip.Range("E5").Value
                
                ' 清空对象，避免下一轮循环误判
                Set ip = Nothing
                Set opsheet = Nothing
            End If
        End If
    Next i
    
    MsgBox "数据复制完成", vbInformation
End Sub

• 执行宏前必须确保remediation.xlsm和int_calculation.xlsx两个文件都处于打开状态
• 如果实际业务中目标表名确实为带空格的Corrected Accruals-xxx格式，将代码中对应表名字符串的下划线改为空格即可
• 如果需要复制整块区域而非单个单元格，可直接使用等号批量赋值，例如opsheet.Range("A5:E100").Value = ip.Range("A5:E100").Value，不需要逐个单元格编写赋值语句，运行效率更高

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