複数行の同列に同じ値があったら、1行に纏める

Excelのマクロをご教示ください。

ファイルは一つです。
シートはいくつもあります。
左から3番目以降のシート、全シートのA列に値（例：123456や999999）が入っています。

複数シートのA列に同じ値が入っていたら１行に纏めたいです。
列はAからCEまで使用しています。

稚拙な説明で申し訳ありませんが、宜しくお願いいたします。

質問者からの補足コメント

• 閉める前に、修正が出来たら教えてください。
  未だ、試用していないので、何とも言えないのですが、
  
  例：
  シート3のA列に111111が5行　　C列に222222 ,333333,444444,555555,666666,
  シート5のA列に111111が5行 AA列に AAAAAA,BBBBBB,CCCCCC,DDDDDD,EEEEEE
  
  メインのシート（結果を出力するシート）には
  A列　111111 C列 222222 AA列 AAAAAA
  A列　111111 C列 333333 AA列 BBBBBB
  A列　111111 C列 444444 AA列 CCCCCC
  A列　111111 C列 555555 AA列 DDDDDD
  A列　111111 C列 666666 AA列 EEEEEE
  
  5行転記される。

  No.1の回答に寄せられた補足コメントです。 補足日時：2023/09/12 16:42

No.2 回答者： tatsumaru77 回答日時： 2023/09/12 19:49

補足要求です。

１．1行目は見出し行でしょうか。（データは２行目から）
それともデータがいきなり始まっているのでしょうか。

２．メインのシート（結果を出力するシート）は、左から１番目もしくは、２番目に必ずあると
いう前提で良いですか。

３．シート３のみA列に11111が5行あり、
他のシートのA列には、11111がなかった場合、メインのシートに11111のとりまとめを行うのでしょうか。
もし、行う場合は、5行転記すればよいのでしょうか。

No.1 回答者： 河内のおやじ 回答日時： 2023/09/12 14:58

参考にしてください。

Sub 同じ値をまとめるマクロ()
Dim ws As Worksheet
Dim wsMain As Worksheet
Dim lastRow As Long
Dim targetValue As Variant
Dim i As Long, j As Long, k As Long

' メインのシート（結果を出力するシート）を設定
Set wsMain = ThisWorkbook.Sheets("メインシートの名前") ' メインシートの名前を設定してください

' メインのシートを初期化
wsMain.Cells.Clear

' 対象のシートからデータをコピー
For Each ws In ThisWorkbook.Sheets
If ws.Index >= 3 Then ' 左から3番目以降のシートを対象に
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
targetValue = ws.Cells(i, 1).Value
If Not IsEmpty(targetValue) Then
' メインのシートで同じ値を探す
For j = 2 To wsMain.Cells(wsMain.Rows.Count, "A").End(xlUp).Row
If wsMain.Cells(j, 1).Value = targetValue Then
' 同じ値が見つかったらデータをコピー
For k = 1 To 84 ' 列数に合わせて調整（CE列までの列数）
wsMain.Cells(j, k).Offset(0, 1).Value = ws.Cells(i, k).Value
Next k
Exit For
End If
Next j
' 同じ値が見つからなかった場合は新しい行を追加
If j > wsMain.Cells(wsMain.Rows.Count, "A").End(xlUp).Row Then
wsMain.Cells(j, 1).Value = targetValue
For k = 1 To 84 ' 列数に合わせて調整（CE列までの列数）
wsMain.Cells(j, k).Offset(0, 1).Value = ws.Cells(i, k).Value
Next k
End If
End If
Next i
End If
Next ws
End Sub

この回答へのお礼

早速ありがとうございます。
誠に申し訳ないのですが、投稿した後に、色々と考えてみたら
質問内容だけでは不足でした。

これはこれで、一度、閉めさせていただきます。
後程、改めて、質問させていただきます。

お礼日時：2023/09/12 15:21