Select 并将特定工作表另存为新工作簿

Question

我需要编写一个宏，允许我 select 我想将哪些工作簿表单独另存为新文件。

我目前正在使用以下代码执行此操作，但它将所有工作表保存为一个新文件。 我希望能够 select 或定义我要保存的工作表。

Sub Save_sheets_xlsx()

Dim Path As String
Path = Application.ActiveWorkbook.Path

Dim FileName As String
FileName = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each xWs In ThisWorkbook.Sheets
    xWs.Copy
    Application.ActiveWorkbook.SaveAs FileName:=Path & "\" & FileName & " " & xWs.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
    
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Answer 1

将工作表导出为新工作簿

Option Explicit

Sub ExportSheets()
    
    Const SheetNameList As String = "Sheet1,Sheet2,Sheet3" ' commas no spaces!

    Dim SheetNames() As String: SheetNames = Split(SheetNameList, ",")
    Dim FolderPath As String: FolderPath = ThisWorkbook.Path
    Dim BaseName As String
    BaseName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)

    Application.ScreenUpdating = False
 
    Dim sh As Object
    Dim FilePath As String
    For Each sh In ThisWorkbook.Sheets(SheetNames)
        sh.Copy
        FilePath = FolderPath & "\" & BaseName & " " & sh.Name & ".xlsx"
        Application.DisplayAlerts = False ' overwrite without confirmation
        Workbooks(Workbooks.Count).SaveAs FileName:=FilePath
        Application.DisplayAlerts = True
        Application.ActiveWorkbook.Close SaveChanges:=False
    Next

    Application.ScreenUpdating = True

    MsgBox "Sheets exported.", vbInformation

End Sub