エクセル VBA 複数シート（シート数はその都度変動）の連続作業 です。

ブックＢのシート1～シート？　までのシートの中を範囲指定して切り取り、ブックＡに挿入貼り付けを繰り返したいのですが、シートの数がその都度変動します。
この場合はどのようにしたらよろしいのでしょうか？
尚、シート1だけの場合は下記のように作りましが・・・・・
（範囲もシートにより変動する為）
ＶＢＡ初心者です。宜しくお願いします。

　Windows("B.xls").Activate
Worksheets(1).Select
Range("A26:R" & Range("R" & Cells.Rows.Count).End(xlUp).Row).Select
Selection.Cut
Windows("A.xlsm").Activate
Rows("2:2").Select
Selection.Insert Shift:=xlDown

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

• 説明が足りなくて申し訳ございませんでした。
  範囲というのはシートにより行数が違うということです。列はＡ～Ｒまでで変わりません。
  貼り付ける場所はＡブックの2行目に順番に挿入貼り付けをしたいのですが・・・
  この説明でお分かりになりますでしょうか？

    補足日時：2015/02/25 20:11

No.3 回答者： High_Score 回答日時： 2015/02/25 22:09

No2です。

すみません、ミス修正です。下記を使用してください。

Sub Macro()

Dim i As Long
Dim colNo As Long
Dim Lastrow As Long
Workbooks.Open Filename:=ThisWorkbook.Path & "\BookB.xlsx"
colNo = 1
For i = 1 To Worksheets.Count
With Worksheets(i)
Lastrow = .Cells(Rows.Count, "R").End(xlUp).Row
If Lastrow < 26 Then GoTo Continue
.Range(.Cells(26, "A"), .Cells(Lastrow, "R")).Copy _
Destination:=ThisWorkbook.Worksheets(1).Cells(2, colNo)
colNo = colNo + 18
Continue:
End With
Next i
Workbooks("BookB.xlsx").Close Savechanges:=False

End Sub

No.2 回答者： High_Score 回答日時： 2015/02/25 21:07

このマクロをBookA.xlsmに貼って起動します。

BookB.xlsxはBookA.xlsmと同一フォルダに置きます。
R列最終行が26行目より上の場合は、データなしとして飛ばします。

Sub Macro()

Dim i As Long
Dim colNo As Long
Workbooks.open filename:=ThisWorkbook.path & "\BookB.xlsx"
colNo=1
For i=1 to WorkSheets.Count
Lastrow=Worksheets(i).Cells(Rows.count,"R").End(xlUp).Row
If Lastrow<26 Then Continue For
Worksheets(i).Range(Cells(26. "A"), Cells(Lastrow, "R")).Copy _
destination:=ThisWorkbook.worksheets(1).Cells(2, colNo)
colNo=colNo+18
Next i
Workbooks("BookB.xlsx").close Savechanges:=False

End Sub

No.1 回答者： High_Score 回答日時： 2015/02/25 19:37

複数シートはどうにでもなります。

問題は

・複数シートはでコピーしたものをそれぞれ何処に貼るのですか？

・シートにより範囲が違うそうですが、A1～R列最終行でいいですか？