excel - 选择特定工作表并将其保存为新工作簿

Question

我需要编写一个宏，允许我选择要单独保存为新文件的工作簿表。
我目前正在使用以下代码执行此操作，但它将所有工作表保存为一个新文件。我希望能够选择或定义要保存的工作表。

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