Select and save specific sheets as new workbook

user_16768294 0
Viewed 64

I need to write a macro that allows me to select which workbook sheets I want to save as a new file separately.

I am currently doing it with the following code, but it saves all the sheets as a new file. I would like to be able to select or define which sheets I want to save.

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
vba excel
1 Answers

Export Sheets As New Workbooks

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
user_98140690
Related