Excel VBA遍历工作簿复制数据到总表触发1004错误如何修复？

1. Range对象未显式绑定父工作表：报错行Set rng = ...中，内部的Range("G2")没有指定所属工作表，VBA默认调用当前活动工作表的Range对象，如果此时活动工作表不是x工作簿的Sheet1，就会出现跨工作表构造Range的逻辑错误，直接触发运行时错误1004。
2. 空数据场景下范围越界：如果源表G列G2单元格以下无数据，Range("G2").End(xlDown)会直接定位到工作表的最大行（约104万行），后续循环遍历十万级空白单元格会直接导致Excel无响应卡死。
3. 工作簿调用逻辑不符合需求：当前代码固定路径打开工作簿x，无法适配后续外层遍历文件夹时直接用已打开的ActiveWorkbook的需求；未判断总表y是否已打开，重复调用Open方法会触发报错。

Sub transferingDataToMaster()
    Dim x As Workbook, y As Workbook, rng As Range, Cell As Range
    Dim roww As Long, lastRow As Long, masterLastRow As Long
    
    ' 关闭屏幕更新提升性能，避免卡顿
    Application.ScreenUpdating = False
    On Error GoTo ErrHandler
    
    ' 适配需求：直接取当前活动工作簿作为源工作簿x
    Set x = ActiveWorkbook
    
    ' 判断总表y是否已打开，未打开则从指定路径打开
    On Error Resume Next
    Set y = Workbooks("Master_Test.xlsm")
    On Error GoTo ErrHandler
    If y Is Nothing Then
        Set y = Workbooks.Open("/Users/esrom/Desktop/P4H/Test/Master_Test.xlsm")
    End If
    
    ' 先计算源表G列最后有数据的行号，避免范围越界
    With x.Sheets("Sheet1")
        lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
        ' G列无有效数据直接退出
        If lastRow < 2 Then GoTo Cleanup
        ' 所有Range显式绑定所属工作表，避免1004错误
        Set rng = .Range("G2:G" & lastRow)
    End With
    
    For Each Cell In rng.Cells
        ' 保留原行号偏移逻辑，如需改为总表末尾追加可替换为下面注释的代码
        roww = Cell.Row + 2
        ' 如需总表逐行追加，替换上面一行为：
        ' roww = y.Sheets("Sheet1").Cells(y.Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row + 1
        
        ' 批量赋值无需重复指定工作表，提升性能
        With y.Sheets("Sheet1")
            .Range("A" & roww).Value = Cell.Value
            .Range("B" & roww).Value = Cell.Offset(0, 6).Value
            .Range("C" & roww).Value = Cell.Offset(0, 7).Value
            .Range("D" & roww).Value = Cell.Offset(0, 8).Value
            .Range("E" & roww).Value = Cell.Offset(0, 10).Value
            .Range("F" & roww).Value = Cell.Offset(0, 11).Value
        End With
    Next
    
Cleanup:
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    Set rng = Nothing
    Set x = Nothing
    Set y = Nothing
    Exit Sub
    
ErrHandler:
    MsgBox "运行出错：" & Err.Description, vbCritical
    Resume Cleanup
End Sub

• 移除了源工作簿x的固定路径打开逻辑，直接取当前ActiveWorkbook，可直接嵌入文件夹遍历的外层循环使用，遍历到的工作簿激活后调用该子过程即可。
• 所有Range对象显式绑定所属工作表，彻底解决1004报错问题。
• 增加了源表数据有效性判断，避免空数据场景下遍历全表空白行导致的卡顿。
• 增加了总表已打开状态判断，避免重复打开报错，新增错误处理和屏幕更新控制，大幅提升运行稳定性和性能。
• 保留了原代码的行号对应逻辑，同时提供了总表末尾追加的可选实现，可根据实际需求切换。

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