[エクセルＶＢＡ]ある範囲の値を取得・格納して一括で別シートに貼り付ける

前提・実現したいこと

図1～3のようなデータベースがあり、それぞれのシートの値を配列に取得・格納した後に
図4のようにシート4へ一括で貼り付けたい
また、A列B列に別の値を貼り付けたい
※都度シート4へ貼り付けではなくFor文から抜け出した後、一括で貼り付けを行いたいです。

発生している問題・エラーメッセージ

図のようになる

該当のソースコード

Sub シート一括貼り付け()
    Dim sh As Worksheet
    Dim CoppyData(100) As Variant
    Dim Aline(2) As Variant   'A列
    Dim Bline(2) As Variant   'B列
    Dim lastRow As Long
    Dim i As Integer

    For i = 0 To 2
        Set sh = wb.Sheets(i)  'i番目のシート        
        Aline(i) = "その" & i
        Bline(i) = "その" & i
        lastRow = Cells(30, "C").End(xlUp).Row  'ラストの行を取得
        CoppyData(i) = sh.Range("A1:G" & lastRow).Value  'シートの値を取得
    Next i

    '一回Forから抜け出したい

　　For i = 0 To 2
            lastRow = Cells(Rows.Count, "A").End(xlUp).Row  'ラストの行を取得    
            Range("A" & lastRow + 1).Resize(UBound(CoppyData, 1)) = Aline(i) 'そのiをA列に貼り付ける
            Range("B" & lastRow + 1).Resize(UBound(CoppyData, 1)) = Bline(i) 'そのiをB列貼り付ける
            Range("C" & lastRow + 1).Resize(UBound(CoppyData, 1), UBound(CoppyData, 2)) = CoppyData(i) 'ここでエラーが発生
    Next i

End Sub

行動規範の内容に同意します

回答1件

ベストアンサー

wb.Sheets(j) CoppyData(j)のjが間違い？

とりあえず、

VBA
1    Dim arr As Variant
2    For i = 0 To 2
3        lastRow = Cells(Rows.Count, "A").End(xlUp).Row  'ラストの行を取得
4        arr = CoppyData(i)
5        Range("A" & lastRow + 1).Resize(UBound(arr, 1)) = Aline(i) 'そのiをA列に貼り付ける
6        Range("B" & lastRow + 1).Resize(UBound(arr, 1)) = Bline(i) 'そのiをB列貼り付ける
7        Range("C" & lastRow + 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
8    Next i
9