VBA For循环复制数据触发1004运行时错误，求排查解决

问题场景 #

我创建了一个包含三个工作表的xlsx文件，分别为Data（数据）、Calculations（公式计算）、Output（输出）。Data表中每个注册号对应一行含28个特征的数据。编写了VBA的For...Next循环，意图依次将Data表的一行数据复制到Calculations表，再将Output表的结果复制到新建的Excel文件中，循环处理每个注册号。

原代码如下：

Sub CopyPaste()
    registration_numbers = Sheets("Data").Range("b1").Value
    Workbooks.Add
    wkb = Morkbooks.Application.ActiveWorkbook.Name
    Sheets.Application.ActiveSheet.Name="Results"
    Sheets.Application.ActiveSheet.Range("a1:i1").Value = ThisWorkbook.Sheets("Output_prg").Range("a1:i1").Value
    For i = 1 To registration_numbers
            x = 1 + i
            If ThisWorkbook.Sheets("Data").Cells(x, 1).Value <> "" Then
                [ThisWorkbook.Sheets("Calculations").Range(Cells(3, 1), Cells(3, 29)).Value = ThisWorkbook.Sheets("Data").Range(Cells(2 + i, 1), Cells(2 + i, 29)).Value]
                Workbooks("wkb").Sheets("Results").Range(Cells(1 + i, 1), Cells(1 + i, 9)).Value = ThisWorkbook.Sheets("Output").Range("a2:i2").Value
            End If
        Next i
End Sub

运行代码时出现“1004”运行时错误，调试时方括号内的代码行被高亮。

错误原因分析 #

1. 方括号语法错误：VBA中方括号[]是Evaluate方法的简写，不能直接用来执行Range赋值操作，这是触发1004错误的直接原因。
2. Cells未指定工作表：Cells(3,1)这类写法默认指向当前活动工作表，而非Calculations或Data表，会导致引用混乱。
3. 拼写错误：Morkbooks是拼写错误，应为Workbooks。
4. 变量引用错误：Workbooks("wkb")写法错误，wkb是存储新工作簿名称的变量，应直接用Workbooks(wkb)（无引号）。
5. 冗余的对象引用：Sheets.Application.ActiveSheet写法冗余，且依赖活动对象易引发错误。

修正后的代码 #

Sub CopyPaste()
    Dim registration_numbers As Long
    Dim wkb As Workbook
    Dim wsData As Worksheet, wsCalc As Worksheet, wsOutput As Worksheet, wsResults As Worksheet
    Dim i As Long
    
    ' 明确绑定各工作表，避免活动对象切换导致的引用错误
    Set wsData = ThisWorkbook.Sheets("Data")
    Set wsCalc = ThisWorkbook.Sheets("Calculations")
    Set wsOutput = ThisWorkbook.Sheets("Output")
    
    ' 转换为长整型，避免数值溢出
    registration_numbers = CLng(wsData.Range("b1").Value)
    
    ' 创建新工作簿并绑定到对象变量
    Set wkb = Workbooks.Add
    Set wsResults = wkb.ActiveSheet
    wsResults.Name = "Results"
    
    ' 复制表头数据
    wsResults.Range("a1:i1").Value = ThisWorkbook.Sheets("Output_prg").Range("a1:i1").Value
    
    ' 循环处理每个注册号
    For i = 1 To registration_numbers
        Dim dataRow As Long
        dataRow = 1 + i
        If wsData.Cells(dataRow, 1).Value <> "" Then
            ' 明确指定每个Cells所属的工作表，消除引用歧义
            wsCalc.Range(wsCalc.Cells(3, 1), wsCalc.Cells(3, 29)).Value = wsData.Range(wsData.Cells(dataRow, 1), wsData.Cells(dataRow, 29)).Value
            
            ' 等待公式计算完成（若Calculations表有依赖输入的公式）
            DoEvents
            
            ' 复制Output表结果到新工作簿
            wsResults.Range(wsResults.Cells(1 + i, 1), wsResults.Cells(1 + i, 9)).Value = wsOutput.Range("a2:i2").Value
        End If
    Next i
End Sub

优化说明 #

• 使用对象变量绑定工作簿和工作表，彻底避免依赖活动对象的隐患。
• 为每个Cells明确指定所属工作表，消除引用歧义。
• 增加DoEvents确保Calculations表的公式计算完成后再复制结果。
• 变量声明为具体数据类型，提升代码稳定性和可读性。

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