コード追加編集方法は？36回のコピ＆べを、1度のマクロ実行で行う

質問

初心者です。WinXP、Excel 2002を使用。
ブックの各シート（１～36シート、1～24シートの時もあり）の最後から3行目だけ（最後行が80行なら78行目全部だけ）を、シート名「集計1」（37シート目）に上から順次書き込むようにするには、下記コードを、どのように追加編集すればよろしいのでしょうか？

１、36シート分（24シート分のときもあり）のシート名は
　・シート1～12　　は　R02061701、R02061702 ～ R02061712
　・シート13～24 　は　R03062701、R03062702 ～ R03062712
　・シート25～36 　は　R08064701、R08064702 ～ R08064712
　のように、それぞれ下2桁だけが1～12まで連番で、3セットで繋がっております。

　・シート37（シート25の時もあり）は　　集計1

２、各シートの最後の行（全シート100行以内）から3行目全部だけ（最後行が80行なら78行目全部だけ）を、「集計1」（シート37（25））の、セルA2→A37（25）まで順次書き込んで行きます。

下記コードは、
　Ctrl+↓（最後のセル）　→　↑にて2つ目の行全体を選択　→　「集計1」の、セルA2へ　コピー＆べースト　だけのコードです。

以上　36回コピー＆べースト　を1回のマクロ実行で行うことができればと思っております。
　　　どうかよろしくお願い致します。
-------------------
Sub 最後から3行目だけコピ＆ベ()
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("R02061701").Select
Range("A17").Select
Selection.End(xlDown).Select
Rows("33:33").Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("集計1").Select
Range("A2").Select
ActiveSheet.Paste
Range("A3").Select
End Sub

回答No.1

papayuka · ベストアンサー

こんな感じでしょうか？
一番左のシートから最後のシートの1つ前までを最終シートに纏めます。
シート枚数は関係ありません。
各シートのA列データが3行未満だと処理しません。

Sub Test()
Dim i As Integer
On Error Resume Next
For i = 1 To Worksheets.Count - 1
　　Worksheets(i).Range("A65536").End(xlUp).Offset(-2, 0).EntireRow.Copy _
　　Destination:=Worksheets(Worksheets.Count).Range("A65536").End(xlUp).Offset(1, 0)
Next i
End Sub

補足

ご回答どうも有難うございます。
すみません、これのみをこのまま、実行（12シート分で）してみたんですけど無反応ですが、どこかを編集しないといけなかったでしょうか？
よろしくお願い致します。

回答No.2

papayuka

# 各シートのA列データが3行未満だと処理しません。
と書いた通り、各シートのA列に最低でも3行データが必要です。

　　Ａ
1　あああ
2　いいい
3　ううう

とある場合に「あああ」の行が最終シートにコピーされます。

この条件に合致しているのに無反応なら On Error Resume Next を削除してエラーメッセージが出るか、出るとしたらどんなメッセージかを書いてみて下さい。

お礼

誠にどうも有難うございました。
次の作業も四苦八苦してる次第でございます。
もし、可能でございましたら、1度ご査収願います。
改めて質問しましたページを載せさせて頂きます。
http://oshiete1.goo.ne.jp/kotaeru.php3?q=2302033

補足

完璧でした。すみません、私が見逃していました。
「集計1」を私が、追加せず、実行したので、最終シートのデータの最後に書き込まれたデータを見事に見逃していました。どうもお手数をおかけして、誠に申し訳ありませんでした。