【VBA】特定のフォルダ内の全ファイルを別ブックとして保存する方法

日々の業務では大量のデータを扱うことが多いと思いますが、その中でも特定のフォルダ内のファイルを個々に別のワークブックとして保存したい場合があります。手作業で行うと時間がかかりますが、このVBAマクロを使用すれば瞬時に処理が完了します。

サンプルコード

VBA

Option Explicit
Sub SaveFilesAsSeparateBooks()
    Dim fso As Object, folder As Object, file As Object
    Dim wb As Workbook, ws As Worksheet
    Dim filePath As String, fileName As String
    
    ' フォルダパスを指定
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder("C:\指定フォルダ名")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For Each file In folder.Files
        filePath = file.Path
        ' ファイルを開く
        Set wb = Workbooks.Open(filePath)
        ' 各ワークシートを別ブックとして保存
        For Each ws In wb.Sheets
            fileName = Left(file.Name, Len(file.Name) - 5) & "_" & ws.Name & ".xlsx"
            ws.Copy
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & fileName
            Application.DisplayAlerts = False ' ファイル保存時の警告を無効化
            ActiveWorkbook.Close SaveChanges:=True
        Next ws
        wb.Close SaveChanges:=False ' 元のファイルは閉じるだけ
    Next file
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

よくある質問

Q 元に戻せますか？

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

Q エラーが出たら？

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