【VBA】開いている全ブックを部分一致で別ブックとして保存する方法

毎回手作業で特定のシートだけを選んで新しいブックを作成するのは労力がかかります。この記事では、開いている全ブックから指定した文字列を含むシートのみを抽出し、新しいブックに保存するVBAマクロを紹介します。

サンプルコード

VBA

Option Explicit
Sub ExtractSheetsToNewBooks()
    Dim wb As Workbook, ws As Worksheet, newWb As Workbook
    Dim strSearch As String, sheetName As String
    
    ' 検索文字列を指定
    strSearch = "部分一致"
    
    Application.ScreenUpdating = False
    For Each wb In Workbooks
        If Not wb.Name Like "*.xls*" Then  ' ワークブックのリストからExcelファイルのみを対象にする
            For Each ws In wb.Sheets
                sheetName = ws.Name
                If InStr(1, sheetName, strSearch) > 0 Then  ' 部分一致検索
                    ws.Copy ' シートを新しいブックにコピー
                    Set newWb = ActiveWorkbook
                    newWb.SaveAs wb.Path & "\" & sheetName & ".xlsx" ' 新しいファイル名で保存
                End If
            Next ws
        End If
    Next wb
    Application.ScreenUpdating = True
End Sub

よくある質問

Q 元に戻せますか？

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

Q エラーが出たら？

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