如何用VBScript将Excel工作表复制/移动到已有工作簿并自定义新表名

我看你现在的代码踩了几个坑，导致只有源工作簿只有一个工作表时才能正常运行——比如没必要创建两个Excel实例，也没正确定位到你指定的xsheet，更没处理重命名和多工作表的场景。下面是完全符合你需求的修正版代码，支持参数化指定源工作表、目标工作表名称，完美适配多工作表的源/目标工作簿：

修正后的完整代码 #

' 可自定义的参数
strSourceWBPath = "C:\Users\x\test.xlsx" ' 源工作簿X的路径
strSourceSheetName = "xsheet" ' 需要复制的源工作表名称（参数）
strTargetWBPath = "C:\Users\x\test1.xlsx" ' 目标工作簿Y的路径
strNewSheetName = "ysheet" ' 复制后新工作表的名称（参数）

' 仅创建一个Excel实例，避免多实例的资源浪费和交互问题
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True ' 若需要后台静默运行，可改为False

' 启用错误捕获，避免因文件/工作表不存在导致脚本崩溃
On Error Resume Next

' 打开源工作簿
Set objSourceWB = objExcel.Workbooks.Open(strSourceWBPath)
If Err.Number <> 0 Then
    MsgBox "打开源工作簿失败：" & Err.Description
    objExcel.Quit
    Set objExcel = Nothing
    WScript.Quit
End If

' 打开目标工作簿
Set objTargetWB = objExcel.Workbooks.Open(strTargetWBPath)
If Err.Number <> 0 Then
    MsgBox "打开目标工作簿失败：" & Err.Description
    objSourceWB.Close False ' 不保存关闭源工作簿
    objExcel.Quit
    Set objExcel = Nothing
    WScript.Quit
End If

' 定位到指定的源工作表
Set objSourceSheet = objSourceWB.Worksheets(strSourceSheetName)
If Err.Number <> 0 Then
    MsgBox "源工作簿中未找到指定工作表：" & strSourceSheetName
    objSourceWB.Close False
    objTargetWB.Close False
    objExcel.Quit
    Set objExcel = Nothing
    WScript.Quit
End If

On Error GoTo 0 ' 关闭错误捕获，恢复正常错误处理

' 将源工作表复制到目标工作簿的最后位置（可修改After参数调整插入位置）
objSourceSheet.Copy After:=objTargetWB.Worksheets(objTargetWB.Worksheets.Count)

' 给新复制的工作表重命名为指定名称
objTargetWB.Worksheets(objTargetWB.Worksheets.Count).Name = strNewSheetName

' 保存目标工作簿，关闭所有文件
objTargetWB.Save
objSourceWB.Close False ' 源工作簿未修改，不保存关闭
objTargetWB.Close False ' 已保存，无需重复保存

' 清理资源，退出Excel
objExcel.Quit
Set objSourceSheet = Nothing
Set objSourceWB = Nothing
Set objTargetWB = Nothing
Set objExcel = Nothing

MsgBox "工作表复制完成！"

关键改进点说明 #

• 单Excel实例：原代码创建了两个Excel.Application实例，完全没必要，单实例足够处理所有操作，还能避免资源浪费
• 精准定位工作表：通过名称Worksheets(strSourceSheetName)直接获取源工作表，不再依赖索引Worksheets(1)，适配多工作表场景
• 参数化配置：所有可变项都放在代码开头的参数区，方便你随时修改路径和工作表名称
• 错误处理：添加了完整的错误捕获逻辑，遇到文件不存在、工作表找不到等情况会友好提示并正确清理资源
• 重命名处理：复制后立即将新工作表重命名为指定的ysheet，避免Excel自动生成的默认名称（比如xsheet(2)）

可选：改为移动工作表操作 #

如果你的需求是移动而非复制工作表，只需在复制完成后添加一行删除源工作表的代码：

' 复制完成后删除源工作表，实现移动效果
objSourceSheet.Delete

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