特定の行ごとに別シートにコピーする方法

お世話になります。
VBAについて相談させて下さい（EXCEL2013）

SHEET1　データのリスト（1行目が項目、2行目からデータでA列の最終行まで20行ごとにSHEET2にコピーしたい）
SHEET2　請求書のフォーム（6行目が項目、内容をコピーできるのはA7～D26の20行まで）

SHEET1には商品や数量、金額のデータが記載してあります。
ここで困っているのが、SHEET2の請求書フォームは品目を書けるのが20行までしかなく、
SHEET1のデータは10～100ぐらいあります。
そこで転記する際に20個記載したら請求書シートをコピーして続き（21個目から）を書くということはできますでしょうか。

請求書1枚目→SHEET1の2～21行目までを貼付け
請求書2枚目→SHEET1の22～41行目までを貼付け
請求書3枚目→SHEET1の42～61行目までを貼付け

複数の会社に作成しているため手間がかかって困ってます。
どうかアドバイスよろしくお願いします。

Sub MACRO()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim i As Long, n As Long
Dim k As Long
Dim LastRow As Long

Set sh1 = Sheets("データ")
Set sh2 = Sheets("請求書")

n = 7 '7行目～27行目まで貼り付けたい

With sh2
LastRow = sh1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To LastRow
.Cells(n, 1).Value = sh1.Cells(i, 3).Value
.Cells(n, 2).Value = sh1.Cells(i, 1).Value
.Cells(n, 3).Value = sh1.Cells(i, 7).Value
.Cells(n, 4).Value = sh1.Cells(i, 8).Value
n = n + 1
Next　　　　　’※27行目まで貼り付けたら次のシートに記載したい
End With
End Sub

No.1 回答者： くんこば 回答日時： 2019/09/12 19:41

なんか、VBAじゃなくても関数でいけそうだけど。

まぁ説明が面倒なんで割愛。

とりあえず、データ件数を印刷件数で割って、あまりがゼロだった場合、印刷用をコピーする。
で、それに貼り付ける。

シート参照を、データシートは固定、印刷シートは可変に変更しないといけないけど。

分かる？

この回答へのお礼

アドバイスありがとうございます。
ただ、具体的に何をどうすれば良いかがさっぱり分からず...。

お礼日時：2019/09/12 21:17

No.2 回答者： googoo900 回答日時： 2019/09/12 22:25

VBAは使う必要ないと思います。

自分なら、請求書作成用のファイルを作ります。SHEET2の請求書のフォームにSHEET1を読み取れるようにしたものです。
一度それを作っておけば、次回からはSHEET1にデータを貼り付けるだけで、SHEET2は完成します。

◆やりかた（●は内容を書いたものなので、具体的な作業はありません）

●請求書1枚目→SHEET1の2～21行目までを貼付け
SHEET2のA7セル『=SHEET1!C2』と入力
SHEET2のB7セル『=SHEET1!A2』と入力
SHEET2のC7セル『=SHEET1!G2』と入力
SHEET2のD7セル『=SHEET1!H2』と入力
上記4セルをコピーして、下方向に26行目まで貼り付けます。

●請求書2枚目→SHEET1の22～41行目までを貼付け
SHEET2のA？セル(2枚目の7行目)『=SHEET1!C22』
SHEET2のB？セル(2枚目の7行目)『=SHEET1!A22』
SHEET2のC？セル(2枚目の7行目)『=SHEET1!G22』
SHEET2のD？セル(2枚目の7行目)『=SHEET1!H22』
上記4セルをコピーして、下方向に20行分貼り付けます。

●請求書3枚目→SHEET1の42～61行目までを貼付け
SHEET2のA？セル(3枚目の7行目)『=SHEET1!C42』
SHEET2のB？セル(3枚目の7行目)『=SHEET1!A42』
SHEET2のC？セル(3枚目の7行目)『=SHEET1!G42』
SHEET2のD？セル(3枚目の7行目)『=SHEET1!H42』
上記4セルをコピーして、下方向に20行分貼り付けます。

この回答へのお礼

すみません。
すでに似たようなことをやっていて、もっと簡略したくて質問させていただきました。

お礼日時：2019/09/12 22:32

No.3 ベストアンサー 回答者： tom04 回答日時： 2019/09/12 22:59

こんばんは！

＞20個記載したら請求書シートをコピーして続き・・・
というコトは元データによってシート数が増えていく！というコトでしょうか？

別案です。
「請求書」シートを使いまわししてはどうでしょうか？
やり方としては、「請求書」シートの26行目までが埋まった段階で
一旦印刷　→　20のデータを消去　→　21番目以降のデータを表示　→　26行目まで埋まれば印刷・・・

といった繰り返しの方法です。
一例です。標準モジュールにしてください。

Sub Sample1()
　Dim i As Long, k As Long, cnt As Long
　Dim wS As Worksheet, myAry

　　Set wS = Worksheets("請求書")
　　myAry = Array(3, 1, 7, 8)
　　　wS.Range("A7,D26").ClearContents
　　　With Worksheets("データ")
　　　　For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　cnt = cnt + 1
　　　　　For k = 0 To UBound(myAry)
　　　　　　wS.Cells(cnt + 6, k + 1) = .Cells(i, myAry(k))
　　　　　Next k
　　　　　If cnt = 20 Then
　　　　　　wS.PrintPreview '//★//
　　　　　　wS.Range("A7:D26").ClearContents
　　　　　　cnt = 0
　　　　　End If
　　　　Next i
　　　　'//▼ピッタリ20行で収まらなかった場合の処理//
　　　　　If cnt Mod 20 > 0 Then
　　　　　　wS.PrintPreview '//★//
　　　　　End If
　　　End With
End Sub

※　印刷プレビューでやめていますが、すぐに印刷したい場合は「★」の行（2か所）の
＞wS.PrintPreview
を
＞wS.PrintOut
にしてください。

※　個人的には一旦印刷プレビューで確認　→　手動で印刷
とした方が良いような気がします。m(_ _)m

この回答へのお礼

希望通りの作業ができました！
ありがとうございました！

お礼日時：2019/09/13 18:35

No.4 回答者： fujillin 回答日時： 2019/09/13 10:10

こんにちは

＞請求書1枚目→SHEET1の2～21行目までを貼付け
＞請求書2枚目→SHEET1の22～41行目までを貼付け
＞請求書3枚目→SHEET1の42～61行目までを貼付け
右側の「SEET1」というのは「SEET2]の間違えとして、2～21行目、22～41行目、42～61行目と空きなく連続しているので、「ページがどうの」と考える必要もないように思えます。
要は、ループなどと考えずとも、コピー元（SEET1？）の2行目以降（最終行まで）をコピー先（SEET2？）の2行目以降にペーストするだけで良いのではないでしょうか？

一方で、
＞’※27行目まで貼り付けたら次のシートに記載したい
27行という数字がどこからきているのか、よくわかりませんね。

などの不明点はありますが、イメージとして。以下のような処理で済んでしまいそうな気がします。
（セル範囲でまとめて処理する方が簡単です。処理はコピペでも良いものと仮定）

Set sourceRange = shi.Cells(2, 1).Resize(LastRow - 1)

sourceRange.Offset(, 2).Copy Destination:= sh2.Cells(2, 1)
sourceRange.Copy Destination:= sh2.Cells(2, 2)
sourceRange.Offset(, 6).Copy Destination:= sh2.Cells(2, 3)
sourceRange.Offset(, 7).Copy Destination:= sh2.Cells(2, 4)

この回答へのお礼

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

お礼日時：2019/09/13 18:36