トップ　>　汎用コード　>　アクティブブックの全シートを一括出力

'***************************************************************
'* アクティブブックの全シートを別ブックとして出力
'*--------------------------------------------------------------
'* 概要     | アクティブブックの全ワークシートを別ブックとして
'*          | 出力（保存）する
'*          | 別ブックに保存する際に数式を値に変換する
'*          | ※シートが保護されている場合は数式を値に変換できない
'*          |   ため予めシートの保護を解除しておくこと
'*          | ※出力先に同名のファイルがある場合は上書きする
'*          | 参考：https://excel.syogyoumujou.com/vba/output_all_sheets.html
'* 引数     | なし
'* 戻り値   | なし
'* 作成日   | 2023.06.24
'*--------------------------------------------------------------
'* 改修履歴 | 2026.04.11
'***************************************************************
Public Sub exportSheetsAsIndividualWorkbooks()

On Error GoTo LBL_ERROR

    '------------------------------
    ' 定数定義
    '------------------------------
    Const BASE_FILENAME As String = "Sample" ' 出力ファイルの基準名

    '------------------------------
    ' 出力先フォルダの選択
    '------------------------------
    MsgBox "出力先のフォルダを選択してください", vbInformation

    Dim strFolderPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            strFolderPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    ' フォルダパスの末尾に区切り文字を追加
    strFolderPath = strFolderPath & Application.PathSeparator

On Error Resume Next

    '------------------------------
    ' 全シートを別ブックとして出力
    '------------------------------
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

    Dim wbkAct     As Workbook
    Dim wbkNew     As Workbook
    Dim wsh        As Worksheet
    Dim lngCount   As Long
    Dim bolProtect As Boolean

    Set wbkAct = ActiveWorkbook

    For Each wsh In wbkAct.Worksheets
        lngCount = lngCount + 1

        ' 新規ブックにシートをコピー
        wsh.Copy

        ' 新規ブックを変数に設定
        Set wbkNew = ActiveWorkbook

        ' シートが保護されていなければ数式を値に変換
        With wbkNew.Worksheets(1)
            If .ProtectContents Then
                bolProtect = True
            Else
                .UsedRange.Value = .UsedRange.Value
            End If
        End With

        ' 基準名+番号をファイル名として新規ブックを保存
        wbkNew.SaveAs strFolderPath & BASE_FILENAME & Format$(lngCount, "000") & ".xlsx"

        ' 新規ブックを閉じる
        wbkNew.Close
    Next wsh

    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

On Error GoTo LBL_ERROR

    '------------------------------
    ' 結果表示
    '------------------------------
    If bolProtect Then
        MsgBox "保護されているシートがありました" & vbLf & _
               "そのシートは数式を値に変換できていません", _
               vbExclamation
    End If

    '------------------------------
    ' 出力先フォルダを開く
    '------------------------------
    Call Shell("C:\Windows\Explorer.exe " & strFolderPath, vbNormalFocus)
    Exit Sub

'------------------------------
' エラー処理
'------------------------------
LBL_ERROR:
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "エラー番号：" & Err.Number & vbLf & _
           Err.Description, vbExclamation, "エラーが発生しました"
End Sub