エクセル ＶＢＡ マクロについてまず先に画像の方を見てほしいのですが、画像は１枚しかアップロードできないので1つのシートにまとめていますが、画像左側の表のようなシートがいくつもあり、そのシートを元に画像右側の表を一番左のシート（シート名はDatum）に生成するマクロを作りたいと考えています。Datumのシートは必ず左側です。品番やカラー、サイズなどの位置は各シートで同じで、カラーとサイズとその数量の範囲もA3:Ｃ17で共通です。A3:Ｃ17なので品番（シート）によってはカラーやサイズが1行だけの時もあれば15行フルでデータが入っている場合もあります。シートの数（品番の数）は注文ごとに変動するので固定ではありません。画像のＦ1がDatumのシートのＡ1に来るようにしたいです。Datumのシートの1行目には既に画像と同じ項目を入力してあるので項目の生成は不要です。Ａ001の表の下にＡ002の表、Ａ003の表が続いていく感じです。この処理を行うマクロは既に手元にあるのですが、今後項目が増える可能性があるらしく、コードを確認したのですが、コードが非常に見づらく、編集しにくいのでここで良い回答を得られたらそれをベースに項目が増えた場合に自分で編集できたらと思っています。どなたか回答よろしくお願いします。

Sub test()

Dim ws As Worksheet, i As Long, rw As Long, D

For Each ws In Sheets

    If ws.Range(\u0026quot;A1\u0026quot;) \u0026amp; \u0026quot; \u0026quot; \u0026amp; ws.Range(\u0026quot;A2\u0026quot;) = \u0026quot;品番 カラー\u0026quot; Then

        rw = ws.Cells(Rows.Count, 1).End(xlUp).Row

        ReDim D(1 To rw - 2, 1 To 5)

        For i = 3 To rw

            D(i - 2, 1) = ws.Cells(1, 2)

            D(i - 2, 2) = ws.Cells(i, 1)

            D(i - 2, 3) = ws.Cells(i, 2)

            D(i - 2, 4) = ws.Cells(1, 4)

            D(i - 2, 5) = ws.Cells(i, 3)

        Next

        Sheets(\u0026quot;Datum\u0026quot;).Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(rw - 2, 5) = D

        Erase D

    End If

Next

End Sub





※データ収集のシートの判定は

A1が品番、A2がカラー,の見出しが入っていることを条件にしています。