VBA代码可复制但无法向其他工作簿粘贴的问题求助

原本运行多年的VBA代码，如今执行粘贴步骤时中断，功能区粘贴选项呈灰色、无内容可粘贴。完整业务流程为：点击发票打印按钮后，「Export Table」工作表填充数据，数据被复制后粘贴至Inventory Tracking文件，随后保存并关闭所有打开的工作簿。已排查数小时未解决，计划逐步回退目标工作簿版本定位故障原因。

原代码如下：

Sub CopyPasteToTracking()

    Sheets("Export Table").Select
    Range("$A$1:$K$" & Range("M1")).Select
    Selection.Copy

    Workbooks.Open Filename:=Sheets("Sales Record").Range("AC6").Value
    ActiveWindow.ScrollWorkbookTabs Sheets:=5
    Sheets("Sales").Activate
    Range("$A$1:$K$1").Paste
        
    For Each w In Application.Workbooks
        w.Save
        Next w
        Application.Quit
        
End Sub

问题分析 #

1. 剪贴板内容丢失：打开新工作簿的操作可能清空剪贴板，且原代码依赖Select/Selection的激活状态，极易因窗口切换导致复制操作失效。
2. 粘贴方法错误：使用Range.Paste而非标准的PasteSpecial，且未明确粘贴类型。
3. 对象引用模糊：所有工作表、单元格范围未指定父工作簿，激活状态变化会导致代码执行偏离预期。
4. 循环保存逻辑风险：遍历所有工作簿保存，可能包含临时文件或不需要保存的工作簿，引发异常。

修复后的代码 #

Sub CopyPasteToTracking()
    Dim sourceWB As Workbook
    Dim sourceWS As Worksheet
    Dim targetWB As Workbook
    Dim targetWS As Worksheet
    Dim lastRow As Long
    
    ' 明确绑定源工作簿与工作表，避免依赖激活状态
    Set sourceWB = ThisWorkbook
    Set sourceWS = sourceWB.Sheets("Export Table")
    
    ' 获取有效复制行数，防止M1为空或无效值
    lastRow = sourceWS.Range("M1").Value
    If lastRow < 1 Then Exit Sub
    
    ' 直接复制目标范围，无需选中
    sourceWS.Range("$A$1:$K$" & lastRow).Copy
    
    ' 打开目标工作簿并绑定工作表，跳过滚动标签的冗余操作
    Set targetWB = Workbooks.Open(Filename:=sourceWB.Sheets("Sales Record").Range("AC6").Value)
    Set targetWS = targetWB.Sheets("Sales")
    
    ' 使用PasteSpecial确保数据与格式完整粘贴
    targetWS.Range("$A$1").PasteSpecial Paste:=xlPasteAll
    
    ' 精准保存关闭目标工作簿，再处理源工作簿
    targetWB.Save
    targetWB.Close
    
    sourceWB.Save
    Application.Quit
End Sub

额外排查步骤 #

• 检查「Export Table」工作表的M1单元格值是否为有效数字，确保复制范围存在数据
• 手动复制A1:K[M1值]范围，打开Inventory Tracking文件后手动粘贴，验证剪贴板功能是否正常
• 确认目标工作簿的「Sales」工作表未被保护（保护状态下无法粘贴）
• 回退版本时，每次仅回退一个版本并测试，精准定位故障引入的版本节点

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