エクセルブックにある複数のワークシートを分割して新しいブックに保存するマクロ

複数のワークシートがタブごとに分けられてるブックで
それぞれのワークシートをコピーして分割して


新しいブックとして保存するマクロ

コード

Sub 各ワークシートをコピーして新しいブックに保存する()
    Dim SourceWorkbook As Workbook
    Dim SourceWorksheet As Worksheet
    Dim NewWorkbook As Workbook
    Dim Path As String
    
    ' ソースとなるワークブックを指定
    Set SourceWorkbook = ThisWorkbook
    
    'パスを取得
    Path = ThisWorkbook.Path
    
    ' 確認ダイアログを表示しないように設定
    Application.DisplayAlerts = False
    
    ' 各ワークシートをコピーして新しいブックを作成
    For Each SourceWorksheet In SourceWorkbook.Sheets
        ' 新しいブックを作成
        Set NewWorkbook = Workbooks.Add
        ' コピー元ワークシートをコピー先ブックにコピー
        SourceWorksheet.Copy Before:=NewWorkbook.Sheets(1)
        ' 新しいブックのsheet1を削除
        NewWorkbook.Sheets("Sheet1").Delete
        
        ' 新しいブックを保存
        NewWorkbook.SaveAs Path & "\" & SourceWorksheet.Name & ".xlsx"
        NewWorkbook.Close SaveChanges:=False
        
        ' オブジェクトの解放
        Set NewWorkbook = Nothing
    Next SourceWorksheet
    
    '　確認ダイアログの設定を元に戻す
    Application.DisplayAlerts = True
    
    MsgBox "完了"
    
End Sub

注意点

• マクロが入ってるフォルダと同じフォルダに新しいブックができる

課題

新しいブックを作って、そこにワークシートをコピーしているが、新しいブックにもともとあったsheet1が残るので、削除するコードを入れている。
手作業と同じように、任意のシートだけをコピーして新しいブックに保存する方法（sheet1の削除が不要）はないのか模索する。
sacu.sacu-ri.com