複数シートの内容を1つのシートに集約したい

Sheet2以降のシートにあるデータをSheet1に集約したいと思います。

Sheet2以降のシートのフォーマットは共通なのですが、データ量（行数）はシートによって異なります（開始が2行目なのは同じ）。
また、シート数も作業ファイルによって異なります。

(例)
Sheet2：50行、Sheet3：70行、Sheet4：200行だった場合
↓
Sheet1の1行目から50行目にsheet2の内容を、
Sheet1の51行目から120行目にsheet3の内容を、
Sheet1の121行目から320行目にsheet4の内容を代入する

Sub test()

    Dim cnt As Long
    Dim saisyugyo As Long
    Dim ws, ws1 As Worksheet
    
    Set ws1 = Worksheets("sheet1")
    
    For Each ws In Worksheets
        If ws.Index <> 1 Then
            saisyugyo = ws.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
            For cnt = 2 To saisyugyo
                ws1.Range("A" & ★ & ":B" & ★).Value = ws.Range("A" & cnt & ":B" & cnt).Value
            Next
        Else
        End If
    Next ws
End Sub

For Each構文を使い、Sheet2以降は1行目から最終行目までを1行ずつSheet1に代入し、全て代入したら次のシートに行く、というのがいいかなと思ったのですが、Sheet1に貼り付ける位置を1行ずつ下にずらしていくところで良い考えが浮かびません。
（★マークのところが該当するかと思います）

なお、Sheet2以降のシートのデータをA2セルから最後のセルまでひとかたまりにコピー＆ペーストする方法をとらないのは、処理が重くなるのを防ぐためです。
実際にコピー＆ペーストの方法で試したら、処理の途中でPCが止まってしまいました。
（あくまで上記例は「例」で、実際はもっとデータ量、シート枚数が多いのです）

良い方法がありましたらご教授頂けますと助かります。
どうぞよろしくお願いいたします。

Excel2010

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

回答1件

ベストアンサー

少し修正してみました。

VBA
1Sub test2()
2    Dim cntFm As Long, cntTo As Long 'カウンタを2つ用意
3    Dim saisyugyo As Long
4    Dim ws As Worksheet, ws1 As Worksheet 'As Worksheet をそれぞれに記載
5   
6    Set ws1 = Worksheets("sheet1")
7
8    cntTo = 1 '転記先先頭行
9    For Each ws In Worksheets
10        If ws.Index <> 1 Then
11            ws.Activate '特に不要であるが追加
12            saisyugyo = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
13'            For cntFm = 2 To saisyugyo
14                ws1.Range("A" & cntTo & ":B" & cntTo + saisyugyo - 2).Value = ws.Range("A" & 2 & ":B" & saisyugyo).Value
15                cntTo = cntTo + saisyugyo - 2 + 1
16'            Next
17'        Else
18        End If
19    Next ws
20    ws1.Activate
21End Sub