ChatGPTでExcelブックのシートをひとつのブックにまとめるマクロの話

　今日は、一日暇だったので、この前の続きで、Excelブックの中にあるシートをひとつにまとめるマクロ（VBA）をChatGPTで作成しました。

　作成の経緯等は以下のブログを参照して下さい。

　ブログその１「ＤＸな対応」、ブログその２「ChatGPTでExcelブックのシートをひとつのCSVにまとめるプログラムの話」

　いろいろと、ごちゃごちゃやってたんだけど、日が経ってみると、すっかり考えが変わって🤔、１番需要があり、使い勝手の良いマクロ（VBA）にした方がいいんじゃないかと思って、ChatGPTを使って、マクロ（VBA）を作り直してみることにした。相変わらず、ChatGPTは無料版でもサクッと作ってくれました🙄

「🥸簡単だとはいっても、ChatGPTに対してしっかりと要件を伝える必要があるので、結局は、ある程度のプログラミングのスキルが必要だとは思います。」

📝マクロ（VBA）に変えた理由に、WSH（Windows Script Host ）って、何だかセキュリティポリシーが変わったら突然使えなくなる可能性があるなと感じたのもあります。

【使い方】

　起動すると、ダイヤログボックスが出て、Excelブックを選択します。複数のExcelブックを選択した場合にも対応してます。そして、一括で複数Excelブックの複数シートをひとつのExcelブックのシートにまとめます。セルについては、値のみではなく書式と計算式とか丸ごとコピーするようにしました。（結合セルもコピーできてます。）

以下はマクロのセットアップ手順です。

1.VBAエディターを開く

　Excelで Alt + F11 を押してVBAエディターを開きます。

2.標準モジュールの挿入

　メニューバーから 挿入 → モジュール を選択します。

　新しいモジュールが 「標準モジュール」 として追加されます（通常「Module1」という名前になります）。

3.コードを貼り付ける

　表示された標準モジュールのウィンドウに、以下のコードをコピー＆ペーストします。

4.VBAエディターを閉じる

　Alt + Q を押してVBAエディターを閉じます。

5.マクロを実行してみる

　Excelに戻り、Alt + F8 を押してマクロダイアログを開きます。

　マクロ一覧から CombineSheetsIntoNewWorkbookを選択し、「実行」をクリックします。

【作成されるExcelブックの仕様】

　元のブック名が SampleData.xlsx の場合、新しいファイルは以下のように保存されます。（複数Excelブックの場合は、ファイル名順で最初に選んだExcelブック名です。）

（SampleData_Combined_20250104_123456.xlsx）

　各シート毎の境に「### File: ファイル名 | Sheet: シート名」を先頭に付与してます。

【ボタン押下で実行するように】

　「開発タブ」の「フォームコントロール」で作成した「ボタン」などからワンクリックでマクロを呼び出すようにすると便利だと思います。

【責任は負いません】

　ちゃんと動くことは確認してますが、前回と同じく、ご利用はご自由ですけど、これを使って何か問題が起こっても僕は一切の責任を負いませんのでよろしくお願いします。

以下がVBA（横スクロールします。）

'----------------------------------------------------------------------
' 2025.01.04
' 作成者: BorderHarry with ChatGPT
' Excelブック内の複数シートをひとつのExcelファイルにまとめる
'
' 本プログラムは、OpenAIが提供するAIモデル「ChatGPT」を利用し、
' その助言やコード生成を活用して作成されました。一部の内容は、
' ChatGPTによる提案を基にBorderHarryが編集および補足しています。
'
'----------------------------------------------------------------------

Option Explicit

Sub CombineSheetsFromSelectedWorkbooks()
    On Error GoTo ErrorHandler ' エラー発生時の処理を設定

    ' ファイル選択ダイアログの設定
    Dim fileDialog As FileDialog
    Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
    With fileDialog
        .Title = "まとめるExcelファイルを選択してください"
        .Filters.Clear
        .Filters.Add "Excelファイル", "*.xls; *.xlsx; *.xlsm"
        .AllowMultiSelect = True
        .InitialFileName = ThisWorkbook.Path & "\"

        If .Show <> -1 Then
            MsgBox "操作がキャンセルされました。", vbExclamation, "キャンセル"
            Exit Sub
        End If

        If .SelectedItems.Count = 0 Then
            MsgBox "ファイルが選択されていません。", vbExclamation, "エラー"
            Exit Sub
        End If

        Dim selectedFiles As Object
        Set selectedFiles = .SelectedItems
    End With

    ' まとめ用シート作成
    Dim combinedSheet As Worksheet
    Set combinedSheet = Application.Workbooks.Add.Worksheets(1)
    combinedSheet.Name = "まとめたシート"

    Dim destRow As Long
    destRow = 1

    ' 選択ファイル処理
    Dim filePath As Variant
    For Each filePath In selectedFiles
        Dim wb As Workbook
        Set wb = Workbooks.Open(filePath)

        Dim ws As Worksheet
        For Each ws In wb.Worksheets
            ' ヘッダー挿入
            With combinedSheet.Cells(destRow, 1)
                .Value = "### File: " & wb.Name & " | Sheet: " & ws.Name
                .Font.Bold = True
                .Font.Italic = True
                .Font.Underline = xlUnderlineStyleSingle
            End With
            destRow = destRow + 1

            ' シートコピー
            ws.UsedRange.Copy
            combinedSheet.Cells(destRow, 1).PasteSpecial Paste:=xlPasteAll
            Application.CutCopyMode = False

            destRow = combinedSheet.Cells(combinedSheet.Rows.Count, 1).End(xlUp).Row + 2
        Next ws

        wb.Close SaveChanges:=False
    Next filePath

    ' 保存
    combinedSheet.Parent.SaveAs _
        fileName:=ThisWorkbook.Path & "\" & _
        Left(Dir(selectedFiles(1)), InStrRev(Dir(selectedFiles(1)), ".") - 1) & _
        "_" & "Combined_" & Format(Now, "yyyymmdd_HHMMSS") & ".xlsx", _
        FileFormat:=xlOpenXMLWorkbook

    MsgBox "選択されたファイルのすべてのシートをまとめました。", vbInformation, "完了"
    Exit Sub

ErrorHandler:
    MsgBox "処理中にエラーが発生しました。" & vbCrLf & _
           "エラー番号: " & Err.Number & vbCrLf & _
           "エラーメッセージ: " & Err.Description, vbCritical, "エラー"
    Exit Sub
End Sub

いろいろと改善点はありそうですが、完成しました♪

ちょっとリファクタリングに手間取りましたけど🤨