【VBA】全てのシートを完全一致で別ブックとして保存する方法

毎日の業務で大量のデータを扱っていると、特定の条件に合致するシートだけを抽出して個別のファイルに保存したいというニーズが出てきます。手作業では時間がかかる上にミスも増えますが、VBAを使用すれば簡単に解決できます。

サンプルコード

VBA

Option Explicit
Sub SaveSheetsAsSeparateBooks()
    Dim wb As Workbook, ws As Worksheet
    Dim newWb As Workbook
    Dim sheetName As String
    
    '現在のワークブックを取得
    Set wb = ThisWorkbook
    Application.ScreenUpdating = False
    For Each ws In wb.Sheets
        If ws.Name Like "Sheet1" Then 'ここに完全一致するシート名を指定します。
            '新しいワークブックを作成
            Set newWb = Workbooks.Add
            
            '現在のシートを新しいワークブックにコピー
            ws.Copy Before:=newWb.Sheets(1)
            
            '元のワークブックから新しいワークブックを削除
            wb.Sheets(ws.Name).Delete
            
            '新しいワークブックを保存
            newWb.SaveAs ThisWorkbook.Path & "\" & ws.Name & ".xlsx"
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

よくある質問

Q 元に戻せますか？

VBAの実行結果は「元に戻す」が効きません。必ずバックアップを取ってから実行してください。

Q エラーが出たら？

シート名や列番号が正しいか確認してください。