Excel数据复制至另一工作表时VBA运行时错误1004修复求助

错误原因分析 #

运行时错误1004的核心问题有两个：

• 代码中错误地复制了整个工作表（Cells.Select），切换到"Estimate Import"工作表后直接粘贴，没有明确指定粘贴起始单元格为A1，导致Excel无法匹配粘贴范围。
• 大量依赖Select/Activate操作，这类操作让宏的运行状态完全依赖当前选中的单元格或活动工作表，极易触发不可预期的错误。

修复后的VBA代码 #

Sub ExportImportFile()
    Dim wsCalc As Worksheet
    Dim wsImport As Worksheet
    Dim newWB As Workbook
    Dim lastRow As Long
    
    ' 直接绑定目标工作表，避免Activate/Select操作
    Set wsCalc = ThisWorkbook.Worksheets("Estimate Import Calc")
    Set wsImport = ThisWorkbook.Worksheets("Estimate Import")
    
    ' 执行排序操作
    With wsCalc.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=wsCalc.Range("N2:N19"), _
            SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange wsCalc.Range("A1:O19")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' 获取N列最后一行数据的行号
    lastRow = wsCalc.Range("N" & wsCalc.Rows.Count).End(xlUp).Row
    
    ' 过滤并删除零值行（添加错误处理，避免无匹配行时报错）
    wsCalc.Range("$A$1:$N$" & lastRow).AutoFilter Field:=14, Criteria1:="0"
    On Error Resume Next ' 若没有符合条件的行，跳过删除步骤
    wsCalc.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    On Error GoTo 0 ' 恢复默认错误处理
    wsCalc.ShowAllData
    
    ' 复制指定范围到Estimate Import工作表的A1起始位置
    wsCalc.Range("A2:O19").Copy
    wsImport.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False ' 清除剪贴板复制状态
    
    ' 将Estimate Import工作表复制到新工作簿
    wsImport.Copy
    Set newWB = ActiveWorkbook
    
    ' 删除新工作簿的第一行
    newWB.Worksheets(1).Rows(1).Delete
    
    ' 保存为CSV文件
    Dim savePath As String
    savePath = ThisWorkbook.Path & "\" & newWB.Worksheets(1).Range("A1").Value & "_ProjectBudget_EstimateImport.CSV"
    newWB.SaveAs Filename:=savePath, FileFormat:=xlCSV, CreateBackup:=False
    
    ' 删除A列并保存关闭新工作簿
    newWB.Worksheets(1).Columns("A").Delete
    newWB.Save
    newWB.Close
End Sub

关键修复说明 #

• 移除Select/Activate操作：通过直接绑定Worksheet对象，彻底摆脱对活动工作表和选中区域的依赖，大幅提升代码稳定性。
• 明确粘贴起始单元格：粘贴时指定wsImport.Range("A1")，严格遵循Excel要求的"粘贴到第一个单元格"规则，直接解决1004错误。
• 优化复制范围：原代码错误复制整个工作表，修复后仅复制需要的A2:O19范围，减少冗余操作。
• 添加错误处理：删除零值行时，若没有匹配的可见行，通过On Error Resume Next跳过删除操作，避免宏中断。
• 明确工作簿引用：复制工作表后，通过Set newWB = ActiveWorkbook绑定新工作簿，避免后续操作混淆原工作簿与新工作簿。

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