Excel 繰り返しマクロ

質問

下記のようなマクロを使ってn個あるシートの内容を「集計」シートにコピーさせるようにしました。
(自動マクロとの組合せなので、スマートではないかもしれませんが)
でも、これだと「集計」シートもコピー作業を行ってしまうので、
「集計」シートはコピー作業をしないように除外したいのですが、どうしたら良いのでしょう?
実際にはシート数は30程度、コピペ項目は1シートあたり30項目程度あります。
よろしくお願いします。

-------------------------
Sub テスト2()
'
For i = 1 To Worksheets.Count

'案件番号等コピー
'
Sheets(i).Select
Range("D3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'案件名
Sheets(i).Select
Range("F3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'国名
Sheets(i).Select
Range("E3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("集計").Select
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'選択セルの解放
Application.CutCopyMode = False

'行挿入
'
Sheets("集計").Select
Rows("4:4").Select
Selection.Insert Shift:=xlDown

Next i

End Sub

回答No.1

n-jun · ベストアンサー

Sub テスト2_NEXT()
Dim ws As Worksheet
'
For Each ws In Worksheets

If ws.Name <> "集計" Then

With Worksheets("集計")

'案件番号等コピー
ws.Range("D3").Copy .Range("A4")

'案件名
ws.Range("F3").Copy .Range("B4")

'国名
ws.Range("E3").Copy .Range("C4")

'行挿入
'
.Rows("4:4").Insert Shift:=xlDown

End With
End If
Next

End Sub

＞コピペ項目は1シートあたり30項目程度あります。
具体的な番地が不明なので、ご参考程度に。

お礼

n-jun様

説明不足にも関わらず、お返事頂きありがとうございます。
お蔭様で、うまくいきました。

ありがとうございました。