Excel VBA脚本突发Runtime错误：Range的Copy方法执行失败求助

针对你遇到的脚本突然报错问题，结合代码细节，以下是具体的排查和修复方案：

1. 修正未限定的Range引用 #

你的代码中设置打印区域时，Range("A1:F" & last_entry).Address没有指定所属工作表，若当前激活的不是目标工作表，会导致打印区域设置错误，进而引发Copy操作失败。修改如下：

' Daily Ship Summary的打印区域
xsht.PageSetup.PrintArea = xsht.Range("A1:F" & last_entry).Address

' Daily Receiving Summary的打印区域
xRSht.PageSetup.PrintArea = xRSht.Range("A1:J" & last_entry_R).Address

2. 等待数据刷新完成再执行后续操作 #

调用ActiveWorkbook.RefreshAll后，后台可能仍在刷新外部数据（比如MiniMRP的链接），此时复制工作表会引发资源冲突。添加等待刷新完成的代码：

ActiveWorkbook.RefreshAll
' 等待所有计算和数据刷新完成
Do Until Application.CalculationState = xlDone
    DoEvents
Loop

3. 明确工作表的父工作簿引用 #

复制工作表时，指定ThisWorkbook避免歧义，同时清理可能残留的临时工作簿：

' 清理可能存在的临时工作簿
On Error Resume Next
Workbooks("Book1").Close SaveChanges:=False
On Error GoTo 0

' 明确从当前工作簿复制工作表
ThisWorkbook.Sheets(Array("Daily Ship Summary", "Daily Receiving Summary")).Copy

4. 检查文件路径与权限问题 #

• 注意到你代码中文件夹名拼写：Daily Recieving Summary应为Daily Receiving Summary（少了一个'e'），这会导致路径不存在，引发后续Export失败反向影响Copy操作。
• 确保用户对V:\MiniMRP Data\Linked Data路径有读写权限，添加文件夹创建逻辑：

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
' 创建Ship Summary文件夹
Dim shipFolder As String
shipFolder = "V:\MiniMRP Data\Linked Data\Daily COG Summary"
If Not fso.FolderExists(shipFolder) Then fso.CreateFolder shipFolder
xFolder = shipFolder & "\" & xDate & " Shipped COG Summary.pdf"

' 创建Receiving Summary文件夹（修正拼写）
Dim receiveFolder As String
receiveFolder = "V:\MiniMRP Data\Linked Data\Daily Receiving Summary"
If Not fso.FolderExists(receiveFolder) Then fso.CreateFolder receiveFolder
xRFolder = receiveFolder & "\" & xDate & " Receiving Summary.pdf"
Set fso = Nothing

5. 修复未初始化变量问题 #

代码中Answer变量未初始化就进行判断，会导致逻辑异常，需在使用前赋值：

' 示例：添加确认对话框（根据实际需求调整）
Answer = MsgBox("是否跳过邮件发送？", vbYesNo, "确认")

6. 排查Excel组件或工作表损坏 #

如果以上代码调整无效，尝试：

• 执行Office快速修复（控制面板>程序>Microsoft Office>更改>快速修复）
• 禁用所有Excel加载项，排查冲突
• 手动复制两个工作表到新工作簿，测试是否报错，判断是否为工作表本身损坏

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