今回はVBAでデータが入力されている複数シートのデータを1つのシートにまとめるコードを紹介します。
目次
やりたいこと
これが完成イメージです。
結合シートに各シートのデータが連番になるようにまとめます。
名前データは「テストデータ・ジェネレータ」をお借りしました。
Sheet1のみ全データを使用
Sheet2は見出し以降のデータを使用
Sheet3は見出し以降のデータを使用
この3シートのデータを結合シートにまとめていきます。
サンプルコード
今回はサンプルとしてSheet1～Sheet3を設定していますが、全シートを参照するようにしているので、シート数が増えても問題ありません。
※データ件数が多い場合でも高速で動くように配列を使用して結合シートにデータをまとめています。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
Sub sample() 'すべてのシートで処理 Dim i As Long Dim ws As Worksheet Dim wj As Worksheet: Set wj = Worksheets("結合シート") '結合シートクリア wj.Cells.Clear Dim Array1 As Variant Dim Array2 As Variant '結合シートの最終行 Dim To_Max_Row As Long 'シートが終わるまで繰り返す For i = 2 To Worksheets.Count Set ws = Worksheets(i) '結合シート以外のデータをまとめる If ws.Name <> "結合シート" Then 'コピーする各シートのデータで最も下にあるデータの行を探す（A列にデータがあることが前提） Dim From_Max_Row As Long From_Max_Row = ws.Range("a" & Rows.Count).End(xlUp).Row If i = 2 Then 'Sheet1をArray1に格納して結合シートに貼り付け Array1 = ws.Range("A1").CurrentRegion wj.Cells(1, 1).Resize(UBound(Array1, 1), UBound(Array1, 2)) = Array1 '配列の初期化 Erase Array1 Else 'Sheet2以降のデータをArray2に格納して結合シートに貼り付け To_Max_Row = wj.Range("a" & Rows.Count).End(xlUp).Row + 1 '各シートのデータを2行目からすべてコピーし、「結合シート」に貼り付けていく ws.Rows("2:" & From_Max_Row).Copy wj.Range("a" & To_Max_Row) '各シートの「見出し」以降のデータを格納 Array2 = Worksheets(i).Range("A1").CurrentRegion.Offset(1, 0) wj.Cells(To_Max_Row, 1).Resize(UBound(Array2, 1), UBound(Array2, 2)) = Array2 '配列の初期化 Erase Array2 End If End If Next i End Sub |