エクセル VBA 繰り返し処理を 簡潔にしたいのでお願いします。

質問

初心者です。繰り返し処理のシート名操作が分かりません。

上手く説明できないのですが、シートの名前が数字の1～20で
特定のセルを参照してテーブルにします。
現在、とても単純なコードを繰り返しています。
すっきりとさせるには、どのように記載するとよいのか
教えてください。

以下の処理を20回ほど繰り返します。
　'シート１の特定セルをコピーします
Sheets("1").Range("c3").Copy
Range("A3").PasteSpecial

Sheets("1").Range("c4").Copy
Range("B3").PasteSpecial

Sheets("1").Range("o2").Copy
Range("C3").PasteSpecial

Sheets("1").Range("o3").Copy
Range("D3").PasteSpecial

Sheets("1").Range("Q6:Q42").Copy
Sheets("集計").Select
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("E3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

'シート２の特定セルをコピーします
Sheets("2").Range("c3").Copy
Range("A4").PasteSpecial

Sheets("2").Range("c4").Copy
Range("B4").PasteSpecial

Sheets("2").Range("o2").Copy
Range("c4").PasteSpecial

Sheets("2").Range("o3").Copy
Range("d4").PasteSpecial

Sheets("2").Range("Q6:Q42").Copy
Sheets("集計").Select
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("E4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

Sheets("3").Range("c3").Copy
Range("A5").PasteSpecial

Sheets("3").Range("c4").Copy
Range("B5").PasteSpecial

Sheets("3").Range("o2").Copy
Range("c5").PasteSpecial

Sheets("3").Range("o3").Copy
Range("d5").PasteSpecial

Sheets("3").Range("Q6:Q42").Copy
Sheets("集計").Select
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("E5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

回答No.2

zap35 · ベストアンサー

例です。シートがない場合のエラー処理は入れていません。

Sub Macro1()
Dim shIdx As Long
For shIdx = 1 To 20　'シート番号で繰り返し
　　Sheets(Trim(Str(shIdx))).Activate　'Str関数で文字列変換
　　Range("c3").Copy Destination:=Range("A3")
　　Range("c4").Copy Destination:=Range("B3")
　　Range("o2").Copy Destination:=Range("C3")
　　Range("o3").Copy Destination:=Range("D3")
　　Range("Q6:Q42").Copy
　　Sheets("集計").Activate
　　Cells(shIdx + 2, "E").Select　'貼り付ける行はshIdxの値で変える
　　Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
　　　　SkipBlanks:=False, Transpose:=True
Next
End Sub

お礼

ありがとうございます。
大変参考になります。ものすごくすっきりしました。

回答No.3

Wendy02

こんばんは。

まあ、参考までに。

要するに、ActiveWindow.ScrollColumn は、要らないというよりも、邪魔になるだけです。

Sub Test2()
Dim i As Integer
　For i = 1 To 2
　 With Worksheets(CStr(i))
　　　.Range("C3").Copy Range("A3")
　　　.Range("C4").Copy Range("B3")
　　　.Range("O2").Copy Range("C3")
　　　.Range("O3").Copy Range("D3")
　　　.Range("Q6:Q42").Copy
　　　Worksheets("集計").Cells(2 + i, "E").PasteSpecial Transpose:=True
　 End With
　Next
　　Application.CutCopyMode = False
End Sub

お礼

ありがとうございます。
ActiveWindow.ScrollColumn は、元がマクロのコピーでコード化したものなので、いらないのに入っていました。
参考になります。ありがとうございます。

回答No.1

pbforce

操作したいことを言葉にしてみましょう。

簡潔に表現できるかもしれません。

ちなみに
～～.ScrollColumn=14から=1って何をやっているのでしょうか？

お礼

ActiveWindow.ScrollColumn は、元がマクロのコピーでコード化したものなので、いらないのに入っていました。
わかりにくい質問ですいませんでした。
ご回答ありがとうございます。