マクロ 繰り返しコピー方法

いつもお世話になっております。
マクロ初心者です。

2つのシートで、【Sheet3】シートから【Ａタイプ】シートへコピーします。
Sheet3→一覧表。Ａタイプ→請求書となります。
№1～№45まで繰り返しコピー&ペーストします。
下記の通り№1と№2で作成しましたが、45回繰り返し作成する方法がわかりません。
おわかりの方、ご教示願います。


Worksheets("Sheet3").Range("F4").Copy　　　　’№1
Worksheets("Ａタイプ").Range("E9").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("G4").Copy Worksheets("Ａタイプ").Range("A9:C9")
Worksheets("Sheet3").Range("D4").Copy
Worksheets("Ａタイプ").Range("A11").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("U4").Copy
Worksheets("Ａタイプ").Range("E19").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("K4").Copy
Worksheets("Ａタイプ").Range("F20").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("L4").Copy
Worksheets("Ａタイプ").Range("F21").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("M4").Copy
Worksheets("Ａタイプ").Range("F22").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("N4").Copy
Worksheets("Ａタイプ").Range("F23").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("Z4").Copy
Worksheets("Ａタイプ").Range("E24").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("AB4").Copy
Worksheets("Ａタイプ").Range("E25").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("AC4").Copy
Worksheets("Ａタイプ").Range("G26").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("H4").Copy
Worksheets("Ａタイプ").Range("F27").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("AF4").Copy
Worksheets("Ａタイプ").Range("G28").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("Q4").Copy
Worksheets("Ａタイプ").Range("G29").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("R4").Copy
Worksheets("Ａタイプ").Range("G30").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("AH4").Copy
Worksheets("Ａタイプ").Range("G31").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("AI4").Copy
Worksheets("Ａタイプ").Range("G32").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("AK4").Copy
Worksheets("Ａタイプ").Range("G33").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("AL4").Copy
Worksheets("Ａタイプ").Range("G34").PasteSpecial Paste:=xlPasteValues

Worksheets("Sheet3").Range("F5").Copy　　　’№2
Worksheets("Ａタイプ").Range("E51").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("G5").Copy Worksheets("Ａタイプ").Range("A51:C51")
Worksheets("Sheet3").Range("D5").Copy
Worksheets("Ａタイプ").Range("A53").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("U5").Copy
Worksheets("Ａタイプ").Range("E61").PasteSpecial Paste:=xlPasteValues

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

• ご回答ありがとうございます。
  説明不足ですみませんでした。
  コピーするセルは横列1行下がります。ペーストするセルは横列42下がります。
  よろしくお願いします。

  No.1の回答に寄せられた補足コメントです。 補足日時：2017/09/17 17:46

No.3 ベストアンサー 回答者： tatsu99 回答日時： 2017/09/17 23:25

>下記の部分は全コピーですが、この部分のみが動きません。

>Worksheets("Sheet3").Range("G4").Offset(fromRow).Copy Worksheets("Ａタイプ").Range("A9:C9").Offset(toRow)

こちらの環境では正常に動作しています。
1回目（G4）と2日目（G5)ですが、添付のような結果になります。
これが、望んだ結果だと思いますが、いかがでしょうか。

この回答へのお礼

すぐにご回答いただきありがとうございます。

セルの結合部分の為、動作しませんでした。
説明不足ですみませんでした。
数式の貼り付けで全て動作できました。
ご丁寧に教えて頂きありがとうございました。

お礼日時：2017/09/18 00:40

No.4 回答者： WindFaller 回答日時： 2017/09/18 00:42

こんばんは。

こういうのは、マクロ・オン・マクロという種類のものではないかと思います。
一旦、表計算上で、コピー元とペースト先を、きれいに整理するのです。
それで、私の場合は、それを整理するためのマクロ(現在は非公開)を作りましたので、マクロ・オン・マクロと呼んでいます。

#1さんご指摘にはあるのですが、どんなイレギュラーなものでも、一対一対応なら可能です。逆に１対１対応していないとエラーメッセージを出します。
バックアップを取ってから、試してみてください。

'//
Sub CopyValueMacro()
　Dim cpyData As Variant
　Dim pstData As Variant
　Dim i As Long, j As Long
　Dim shA As Worksheet
　Dim sh3 As Worksheet
　Set shA = Worksheets("Ａタイプ")
　Set sh3 = Worksheets("Sheet3")

　cpyData = Split("F4,D4,U4,K4,L4,M4,N4,Z4,AB4,AC4,H4,AF4,Q4,R4,AH4,AI4,AK4,AL4", ",")
　pstData = Split("E9,A11,E19,F20,F21,F22,F23,E24,E25,G26,F27,G28,G29,G30,G31,G32,G33,G34", ",")
　If UBound(cpyData) <> UBound(pstData) Then
　　MsgBox "データの数が違います", vbCritical
　　Exit Sub
　End If
　For j = 0 To 44
　　sh3.Range("G4").Offset(j).Copy shA.Range("A9:C9").Offset(j * 42)
　　For i = 0 To UBound(cpyData)
　　　shA.Range(pstData(i)).Offset(j * 42).Value = sh3.Range(cpyData(i)).Offset(j).Value
　　Next i
　Next j
End Sub

この回答へのお礼

こんばんは。
ご丁寧にデータ数のチェック方法までありがとうございました。
参考に使わせて頂いきます。
今回は色々とありがとうございました。
大変勉強になりました。

お礼日時：2017/09/18 02:06

No.2 回答者： tatsu99 回答日時： 2017/09/17 20:06

>コピーするセルは横列1行下がります。

ペーストするセルは横列42下がります。
コピー元：F4の2回目はF5
ペースト：E９の2回目は、E５１になれば良い訳ですね。
（列は変わらず、コピー元は１行が増分、コピー先は４２行が増分）

以下のようにしてください。
Worksheets("Sheet3").Range("F4").Copy　　　　’№1
Worksheets("Ａタイプ").Range("E9").PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("G4").Copy Worksheets("Ａタイプ").Range("A9:C9")
Worksheets("Sheet3").Range("D4").Copy
Worksheets("Ａタイプ").Range("A11").PasteSpecial Paste:=xlPasteValues
を変える場合です。
Sub sample()
Dim i As Long
Dim fromRow As Long
Dim toRow As Long
For i = 1 To 45
fromRow = i - 1
toRow = (i - 1) * 42
Worksheets("Sheet3").Range("F4").Offset(fromRow).Copy '№1
Worksheets("Ａタイプ").Range("E9").Offset(toRow).PasteSpecial Paste:=xlPasteValues
Worksheets("Sheet3").Range("G4").Offset(fromRow).Copy Worksheets("Ａタイプ").Range("A9:C9").Offset(toRow)
Worksheets("Sheet3").Range("D4").Offset(fromRow).Copy
Worksheets("Ａタイプ").Range("A11").Offset(toRow).PasteSpecial Paste:=xlPasteValues
Next
End Sub

同様にして他の箇所も変えてください。
コピー元は、.offset(fromRow)　を追記
コピー先は、.offset(toRow) を　追記します。

この回答へのお礼

早速のご教示、ありがとうございます。

下記の部分は全コピーですが、この部分のみが動きません。
Worksheets("Sheet3").Range("G4").Offset(fromRow).Copy Worksheets("Ａタイプ").Range("A9:C9").Offset(toRow)
それ以外は動きました。

お礼日時：2017/09/17 22:51

No.1 回答者： NURU_osan 回答日時： 2017/09/17 17:23

考えるのがめんどくさい＆勘違いによる誤回答防止のために伺いますが、コピーするセルとペーストするセルのそれぞれの座標の位置関係に法則はありますか？

法則が無いなら繰り返し処理はできません。