【VBA】別々のSheetのデータを１つにまとめる(コピーする)
上の画像のように、
見出し行が１行目に有り、２行目以降にデータがある表が
１つのBookの別々のSheetに点在している時、
その表データを一気に１つにまとめるコードを作成しました。
以下、サンプルコードと説明です。
サンプルコード①通常範囲コピペ
'見出し行を除いたデータをコピーしてまとめる
Dim myRng1, myRng2 As Range
Dim mySht As Worksheet
Set myRng1 = ThisWorkbook.Worksheets("まとめ").Range("A1").CurrentRegion
‘ [まとめ] Sheet以外の各シートのデータをコピペする
For Each mySht In Worksheets
If mySht.Name <> "まとめ" Then ‘①
Set myRng2 = mySht.Range("A1").CurrentRegion ‘②
Set myRng2 = myRng2.Resize(myRng2.Rows.Count - 1).Offset(1, 0) ‘③
myRng2.Copy myRng1.Offset(myRng1.CurrentRegion.Rows.Count) ‘④
End If
Next
↑のサンプルコードでは
Sheet名『まとめ』に、
『まとめ』以外のSheetに記載されたデータを
コピーして順々に貼り付けていく
そのようなコードになっております。
Sheet名は特に問いません。コード内容は
Sheet名『まとめ』以外のSheetを順々に処理するように
と、設定されています。
コード内容の簡易解説
①で『まとめ』以外のSheetを指定
②で各Sheetでの表全体を変数 [myRng2] に格納
③でさらに [myRng2] の範囲を最下行１行減
→さらにその範囲全体を１行下へスライド → copy
④でSheet『まとめ』の書き出し部分に③のコピー部分を貼付け
このような内容です。
サンプルコード②元データに空白行があった場合
サンプルコードの２つ目は
“もしも表中に空白行があった場合” です。
こういったデータもまれに存在するのではないでしょうか？
サンプルコード①は空白行があると最後まで選択してくれません。
以下のコードであれば、空白行が途中で差し込まれていても
お構いなしに範囲選択 → コピーします。
'見出し行を除いたデータをコピーしてまとめる
Dim EndLine1, EndLine2, EndLine3 As Long
Dim myRng As Range
Dim mySht1, mySht2 As Worksheet
Set mySht1 = ThisWorkbook.Worksheets("まとめ")
EndLine1 = mySht1.Cells(1, Columns.Count).End(xlToLeft).Column ‘①
For Each mySht2 In Worksheets
If mySht2.Name <> "まとめ" Then ‘②
EndLine2 = mySht1.Cells(Rows.Count, 1).End(xlUp).Row + 1 ‘③
EndLine3 = mySht2.Cells(Rows.Count, 1).End(xlUp).Row ‘④
Set myRng = mySht2.Range(mySht2.Cells(2, 1), mySht2.Cells(EndLine3, EndLine1)) ‘⑤
myRng.Copy mySht1.Cells(EndLine2, 1) ‘⑥
End If
Next
コード実行で得られる結果は①のモノと同じです。
但し、たとえ表の途中に空白行があっても、
飛び越えて全範囲をコピー＆まとめてくれます。
コード内容の簡易解説
①で元データの右端が何列目か？(何列目迄範囲にするか？)
②で『まとめ』以外のSheetを指定
③で『まとめ』の書き出し部分が何行目か特定
④で『まとめ』以外のSheetの最下行を取得
⑤で見出しを除いた表データ中身のみを変数 [myRng] に格納
⑥で [myRng] copy → 『まとめ』に貼付け
②～⑥を『まとめ』以外の全Sheet終了するまでループ処理
こんな感じです。
毎月の売上データやその他データ集積には役立つコードになっているかと思います。以上、何かのお役に立てれば幸いです。