如何将工作簿各工作表另存为独立文件？现有VBA代码修改咨询

原代码的问题在于直接调用ws.SaveAs会将整个当前工作簿重命名保存，而非单独导出目标工作表。以下是修改后的代码，可实现将每个工作表单独保存为与表名一致的独立文件：

Sub Save_Tabs()
    Dim ws As Excel.Worksheet
    Dim SaveToDirectory As String
    Dim newWB As Workbook
    
    SaveToDirectory = "E:\NYCHHC\CSOD\Reports\completion reports\"
    
    ' 确保保存目录末尾有斜杠，避免路径拼接错误
    If Right(SaveToDirectory, 1) <> "\" Then
        SaveToDirectory = SaveToDirectory & "\"
    End If
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False ' 关闭屏幕刷新，提升运行效率
    
    For Each ws In ThisWorkbook.Worksheets
        ' 将当前工作表复制到新工作簿（新工作簿会自动激活）
        ws.Copy
        Set newWB = ActiveWorkbook
        
        ' 保存新工作簿，文件名与工作表名称一致
        newWB.SaveAs Filename:=SaveToDirectory & ws.Name, FileFormat:=xlOpenXMLWorkbook ' 默认xlsx格式，可按需修改
        
        ' 关闭新工作簿
        newWB.Close SaveChanges:=False
        Set newWB = Nothing
    Next ws
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

关键改动说明 #

• 复制工作表到新工作簿：使用ws.Copy会自动创建一个仅包含当前工作表的新工作簿，这是实现单独保存的核心操作
• 路径合法性处理：增加了目录末尾斜杠的判断，避免因路径拼接错误导致保存失败
• 优化运行体验：关闭ScreenUpdating减少屏幕闪烁，提升代码运行速度
• 恢复默认设置：操作完成后恢复DisplayAlerts和ScreenUpdating的默认状态，避免影响后续Excel操作

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