VBA跨工作簿复制代码首次运行报错，二次运行正常问题排查

问题描述 #

我尝试用VBA将一个工作簿里的工作表数据复制到另一个工作簿。首次运行代码时会弹出Run-time error 1004：Range类的PasteSpecial方法执行失败，但再次运行就能正常工作。我确定问题和活动工作簿/工作表有关，但找不到具体原因。相关代码如下：

Sub CopySupplierList()
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = True
    Application.EnableEvents = False
    'Application.ScreenUpdating = False
    
    Dim file_path As String
    Dim file_name As String
    Dim WS_FileLoc As Worksheet
    Dim wbname As String
    Dim WB_main As Workbook
    Dim WB_toUpdate As Workbook
    
    Set WB_main = ThisWorkbook
    Dim WS_active As String
    WS_active = ActiveSheet.Name
    
    If WS_active <> "TASK - Map and Validation" Then
    MsgBox "Please Close all other spreadsheets before running this process", vbInformation, PROC_TITLE
    GoTo ProcessEnd
    End If
    
    Set WS_FileLoc = Sheets("CONFIG - File Locations")
     ' Get work sheet
    Set wsf = Sheets("TASK - Map and Validation")
   '=====================================================================================
   wbname = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
    file_path = WS_FileLoc.Range("B3").Value
    file_name = file_path & "/" & "Upload List.xlsx"
    Workbooks.Open FileName:=file_name
    Set WB_toUpdate = ActiveWorkbook
    
    WB_main.Activate
    wsf.Activate
    Dim wst As Worksheet
    Set wst = Sheets("TASK - Map and Validation")
    Set wsf = Sheets("DATA - PriceList")
    
    wsf.Activate
    ActiveSheet.Unprotect
    wsf.Range("A1:u1").Select
   wsf.Range(Selection, Selection.End(xlDown)).Copy
 
    WB_toUpdate.Close
    WB_main.Activate
    wst.Unprotect
    wst.Activate
    wst.Range("v6:ao6").Select
    Application.DisplayAlerts = False
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("a1").Activate
       wst.Range("v6:ao6").Interior.Color = 15773696
        Application.DisplayAlerts = True
    ActiveSheet.Protect
    WB_toUpdate.Close
    ProcessEnd:
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End Sub

问题根源 #

1. 过早关闭目标工作簿：复制数据后立刻关闭WB_toUpdate，首次运行时系统剪贴板还未完全缓存数据，导致粘贴失败；再次运行时剪贴板残留了之前的数据，所以能正常执行。
2. 依赖Activate/Select操作：这类操作完全依赖当前活动的工作簿/工作表，一旦系统状态和代码预期不符就会出错。
3. 变量重复赋值：wsf先指向"TASK - Map and Validation"，随后又被重新赋值为"DATA - PriceList"，逻辑混乱。
4. 重复关闭工作簿：代码末尾再次调用WB_toUpdate.Close，此时该工作簿已经关闭，会触发额外错误。

修正后的代码 #

Sub CopySupplierList()
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = True
    Application.EnableEvents = False
    Application.ScreenUpdating = False ' 开启屏幕刷新关闭，提升性能
    
    Dim file_path As String
    Dim file_name As String
    Dim WS_FileLoc As Worksheet
    Dim WB_main As Workbook
    Dim WB_toUpdate As Workbook
    Dim ws_source As Worksheet ' 源数据工作表
    Dim ws_target As Worksheet ' 目标粘贴工作表
    Dim source_range As Range
    
    Set WB_main = ThisWorkbook
    
    ' 检查当前活动工作表是否正确
    If ActiveSheet.Name <> "TASK - Map and Validation" Then
        MsgBox "请关闭所有其他表格后再运行此程序", vbInformation, "提示"
        GoTo ProcessEnd
    End If
    
    ' 初始化工作表对象
    Set WS_FileLoc = WB_main.Sheets("CONFIG - File Locations")
    Set ws_source = WB_main.Sheets("DATA - PriceList")
    Set ws_target = WB_main.Sheets("TASK - Map and Validation")
    
    ' 获取目标文件路径并打开
    file_path = WS_FileLoc.Range("B3").Value
    file_name = file_path & "/" & "Upload List.xlsx"
    Set WB_toUpdate = Workbooks.Open(FileName:=file_name)
    
    ' 取消源工作表保护并复制数据
    ws_source.Unprotect
    ' 确定要复制的范围（从A1:U1向下到最后一行数据）
    Set source_range = ws_source.Range("A1:U1").Resize(ws_source.Cells(ws_source.Rows.Count, "A").End(xlUp).Row)
    source_range.Copy
    
    ' 切换到目标工作表粘贴数据
    ws_target.Unprotect
    ws_target.Range("V6").PasteSpecial Paste:=xlPasteValues ' 从V6开始粘贴，自动匹配列数
    ws_target.Range("V6:AO" & ws_target.Cells(ws_target.Rows.Count, "V").End(xlUp).Row).Interior.Color = 15773696 ' 给粘贴区域上色
    
    ' 清理剪贴板，恢复保护
    Application.CutCopyMode = False
    ws_source.Protect
    ws_target.Protect
    
    ' 关闭目标工作簿（不保存，根据需求调整SaveChanges参数）
    WB_toUpdate.Close SaveChanges:=False
    
ProcessEnd:
    ' 恢复应用程序设置
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

关键修改说明 #

• 移除Activate/Select：直接通过工作表对象引用操作，彻底避免活动状态依赖问题。
• 调整工作簿关闭时机：等粘贴完成后再关闭WB_toUpdate，确保剪贴板数据有效。
• 明确变量用途：用ws_source和ws_target分别指代源/目标工作表，避免变量重复赋值混乱。
• 精确获取数据范围：用Resize和End(xlUp)动态获取最后一行数据，避免空行或遗漏数据。
• 清理剪贴板：用Application.CutCopyMode = False释放剪贴板资源，避免残留影响。

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