【ChatGPT×VBA】複数シートのデータを、縦にコピーし、1枚にまとめる

複数シートのデータを、縦にコピーし、1枚にまとめる

先頭に「まとめ」シートを作成し、すべてのシートのデータを1枚にまとめます。

ChatGPTのプロンプト

以下のVBAコードを作成できますか？
マクロ名は「 デモ 」とする。また、日本語でコメントをいれる。
概要：複数のワークシートのデータを「 まとめ 」シートにまとめる
手順：
・すべてのワークシートをループして、名前が「 まとめ 」のシートが存在するかを確認する。
・「まとめ」シートが存在しない場合、先頭に「 まとめ 」シートを追加する。
・「まとめ」 シートが存在する場合、その内容をクリアする。
・すべてのワークシートをループして、各シートで次の処理を実行する。
・シートの名前が「まとめ」 でない場合、そのシートのデータを「 まとめ 」シートにコピーする。 
・コピーする範囲は、各シートの「 A1 」セルから 「 C列 」の最終行まで。
・条件分岐により、「 まとめ 」シートの「 A1 」セルが空白の場合、コピーしたデータを「 A1 」セルに貼り付ける。それ以外は「 まとめ 」シートの表全体の末端にデータを貼り付ける。
・コードの最初に画面の更新と警告の表示を停止し、コードの最後でそれらを再開する。

（ポイント１）上の「プロンプトをコピーする」ボタンで、コピーできます。

（ポイント２）ChatGPTに貼り付けて、緑色の単語を、あなたの処理に合わせて修正します。内容の削除や追加もできます。
(注：プロンプトの全てを読む必要はありません。緑色の行のみ集中して読み、修正してください）

（ポイント３）会話のスタイルは、「より厳密に」を選択します。

（ポイント４）プロンプトの改行は、ShiftキーとEnterキーを同時に押します。

ChatGPTの回答

もちろんです。以下に指定の条件に基づいたVBAコードを示します：

Sub デモ()
    ' 画面の更新と警告の表示を停止
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim ws As Worksheet
    Dim summarySheet As Worksheet
    Dim copyRange As Range
    Dim destCell As Range

    ' 「まとめ」シートが存在するか確認
    On Error Resume Next
    Set summarySheet = ThisWorkbook.Sheets("まとめ")
    On Error GoTo 0

    ' 「まとめ」シートが存在しない場合、先頭に追加
    If summarySheet Is Nothing Then
        Set summarySheet = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1))
        summarySheet.Name = "まとめ"
    Else
        ' 「まとめ」シートが存在する場合、内容をクリア
        summarySheet.Cells.Clear
    End If

    ' すべてのワークシートをループ
    For Each ws In ThisWorkbook.Sheets
        ' シートの名前が「まとめ」でない場合、データをコピー
        If ws.Name <> "まとめ" Then
            Set copyRange = ws.Range("A1:C" & ws.Cells(ws.Rows.Count, "C").End(xlUp).Row)
            Set destCell = summarySheet.Cells(summarySheet.Cells(summarySheet.Rows.Count, "A").End(xlUp).Row + 1, "A")

            ' 「まとめ」シートのA1セルが空白の場合、A1セルに貼り付け
            If Application.WorksheetFunction.CountA(summarySheet.Cells) = 0 Then
                Set destCell = summarySheet.Range("A1")
            End If

            ' データを貼り付け
            copyRange.Copy destCell
        End If
    Next ws

    ' 画面の更新と警告の表示を再開
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

プロンプトを作成し、VBAコードを実行してみて！　ChatGPT凄い！！😊

VBAマクロを無料のChatGPT（Microsoft Copilot）で作成します。

Copilot(https://copilot.microsoft.com)はログイン不要。すぐVBAマクロが完成します。