如何将工作簿多工作表存为新工作簿并重命名、解决424错误及断开链接

1. 解决Run Time Error 424（需要对象）及保存失败问题 #

原代码核心错误是对Worksheets.Copy方法的使用逻辑错误：

• 复制多个工作表时，Copy方法会直接生成新工作簿，但它没有返回值，无法赋值给Worksheet类型的变量sourceWs，这直接触发了424错误。
• 后续调用sourceWs.Copy完全无效，因为sourceWs并未指向任何有效对象。

修正后先捕获新生成的工作簿，再执行保存：

Option Explicit

Sub Copysheetandsave()
    Dim newWb As Workbook
    Dim savePath As String
    
    ' 复制指定工作表到新工作簿，捕获生成的新工作簿
    ThisWorkbook.Worksheets(Array("S&M", "400", "410")).Copy
    Set newWb = ActiveWorkbook
    
    ' 获取当前用户个人文件夹（避免硬编码路径的权限或适配问题）
    savePath = Environ("USERPROFILE") & "\"
    ' 保存新工作簿，指定格式为标准xlsx
    newWb.SaveAs Filename:=savePath & "YTD 2023 YTD.xlsx", FileFormat:=xlOpenXMLWorkbook
    
    ' 后续添加断开链接逻辑...
    
    newWb.Close False
End Sub

额外注意：

• C:\Users\是系统根目录，直接保存可能有权限限制，用Environ("USERPROFILE")自动获取当前用户的个人文件夹（如C:\Users\你的用户名\）更安全通用。
• 如果要保存到特定子文件夹，需先确认文件夹存在，不存在可添加MkDir语句创建（需先做存在性判断）。

2. 添加断开原工作簿链接的逻辑 #

在保存前、关闭新工作簿前，加入以下代码遍历并断开外部链接：

' 断开新工作簿与原工作簿的Excel外部链接
Dim link As Variant
For Each link In newWb.LinkSources(xlExcelLinks)
    newWb.BreakLink Name:=link, Type:=xlExcelLinks
Next link

完整最终代码：

Option Explicit

Sub Copysheetandsave()
    Dim newWb As Workbook
    Dim savePath As String
    Dim link As Variant
    
    ' 复制指定工作表到新工作簿
    ThisWorkbook.Worksheets(Array("S&M", "400", "410")).Copy
    Set newWb = ActiveWorkbook
    
    ' 设置保存路径为当前用户个人文件夹
    savePath = Environ("USERPROFILE") & "\"
    
    ' 断开所有Excel类型的外部链接
    For Each link In newWb.LinkSources(xlExcelLinks)
        newWb.BreakLink Name:=link, Type:=xlExcelLinks
    Next link
    
    ' 保存并关闭新工作簿
    newWb.SaveAs Filename:=savePath & "YTD 2023 YTD.xlsx", FileFormat:=xlOpenXMLWorkbook
    newWb.Close False
End Sub

关键说明 #

• 用newWb变量直接操作新工作簿，避免依赖ActiveWorkbook（防止操作过程中窗口焦点切换导致错误）。
• BreakLink方法针对Excel类型链接，若有其他类型外部链接（如Word、CSV），可将xlExcelLinks替换为对应枚举值。

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