エクセルのリストから同エクセル内の別シートに差込印刷をしたいです

添付しております画像の差込リストシート（全部で150件位あります）から報告書シートの該当のセルへ差し込み印刷をしたいのですが、色々検索してみますがいまいちつかめません。
印刷枚数ですが提出用と控えがあるため同じ物を必ず2枚ずつ印刷します
2枚印刷して次のリスト→2枚印刷して次のリスト･･･というふうに自動印刷をかけたいです。

エクセルでそれぞれでシートを作成しても150以上のシートをずっと印刷するのは非効率と思い一度に印刷できるＶＢＡを教えて頂けませんでしょうかｍ(_ _)ｍ

現在は毎月手書きにてやっておりますのでかなり時間を要している状態にあります。

No.1 回答者： tom04 回答日時： 2016/01/21 16:35

こんにちは！

元データはSheet1にあり、印刷するのはSheet2とします。
尚、Sheet2の日付セル（I4）の表示形式は好みの日付に設定しておいてください。
標準モジュールです。

Sub Sample1()
Dim i As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
wS.Range("B1") = .Cells(i, "A")
wS.Range("C4") = .Cells(i, "B")
wS.Range("I4") = .Cells(i, "C")
wS.PrintPreview '←★//
Next i
End With
End Sub

※　印刷プレビューでやめています。
間違いなければ「★」の行
＞wS.PrintPreview '←★//
を
＞wS.PrintOut copies:=2
に変更して実行してみてください。m(_ _)m

この回答へのお礼

早々にありがとうございます！
ためしにmicrosoft xpsで印刷をかけてみましたが、同じリストが2部印刷されませんが、wS.PrintOut copies:=2へ書き換えしています！なぜでしょうか？
あとリストは毎月増えていくのですが、セルになにも入っていない行があるとそこまでしか印刷されないという仕組みでよかったでしょうか？（それならばどんどん足していけば良いだけですもんね！）

質問ばかりで申し訳ございません。
私の前回の質問にも大変にご丁寧にご解答してくださった tom04様、今回も恐縮ですありがとうございます！！！！

お礼日時：2016/01/21 17:21

No.2 回答者： tom04 回答日時： 2016/01/21 19:18

No.1です。

まず
＞セルになにも入っていない行があるとそこまでしか印刷されないという仕組みでよかったでしょうか？

について
A列で最終行を取得していますので、
2行目～A列最終行まで印刷が繰り返されます。

さて、2部印刷できない？
今こちらで5行程度のサンプルで前回のコードを試してみました。
ちゃんと２部ずつ印刷されました。
ですので、原因はこちらではちょっと判りません。
ごめんなさい。m(_ _)m

この回答へのお礼

XPSでは2部印刷出来ないみたいでした。すいません。

もしよければ最後にもうひとつだけ宜しいでしょうか。
控えの方に印鑑が必要で電子印鑑を押しておきたい場合で

sheet3に同じように報告書を作り
リストからsheet2を一部印刷→sheet3を一部印刷→次のリストというふうにすることは可能でしょうか？

いつもすいません（＞＜）

お礼日時：2016/01/22 03:04

No.3 回答者： ExcelDevTool 回答日時： 2016/01/21 21:46

Excelのアドインで簡単にできます。

下記の例をご参考ください。

http://superdbtool.com/blog/archives/698

この回答へのお礼

ありがとうございます。今後参考にさせて頂きますm(_ _)m

お礼日時：2016/01/22 03:04

No.4 回答者： tom04 回答日時： 2016/01/22 08:29

No.1・2です。

やはり1部しか印刷できないみたいですので、
＞控えの方に印鑑が必要で電子印鑑を押しておきたい場合で・・・

一案ですが、Sheet2を印刷するマクロを2度実行してみてはどうでしょうか？
一度目は「電子印鑑」がないSheet2で、二度目は「電子印鑑」をSheet2に表示（挿入）させ
もう一度同じマクロを実行！

もちろんSheet2・Sheet3を続けて印刷するコードを記載しても良いのですが、
上記の案を検討してみてください。
それでもダメならもう一度コードを記載させていただきます。m(_ _)m

この回答へのお礼

おはようございます！
私も二度印刷することを考えたのですが、用紙が正副と続きになっておりまして、2度の印刷にした場合
下準備で正副の用紙を一旦、正と副に分け、印刷後、再度正副に整理しなければならない為
効率を考えると一度で印刷することが出来れば、高効率になりまして
是非ともお力をお貸し頂けるとうれしい所存ですm(_ _)m

お礼日時：2016/01/22 08:49

No.5 ベストアンサー 回答者： tom04 回答日時： 2016/01/22 09:06

続けてお邪魔します。

＞用紙が正副と続きになっておりまして・・・
そういう理由があったのですね。
それではもう一度コードを載せてみます。
Sheet2とSheet3のレイアウトは同じ配置だとします。
今回も標準モジュールです。

Sub Sample2()
Dim i As Long, wS2 As Worksheet, wS3 As Worksheet
Set wS2 = Worksheets("Sheet2")
Set wS3 = Worksheets("Sheet3")
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
'▼Sheet2の処理//
wS2.Range("B1") = .Cells(i, "A")
wS2.Range("C4") = .Cells(i, "B")
wS2.Range("I4") = .Cells(i, "C")
'▼Sheet3の処理//
wS3.Range("B1") = .Cells(i, "A")
wS3.Range("C4") = .Cells(i, "B")
wS3.Range("I4") = .Cells(i, "C")
'▼両Sheetを印刷//
wS2.PrintOut
wS3.PrintOut
Next i
End With
End Sub

※　粛々と順番にやっているだけです。m(_ _)m

この回答へのお礼

朝一からご回等ありがとうございました。
無事印刷することが出来ました。

今月よりすごく効率よく報告書の作成が出来ます！
今後もっと勉強して私自身でもっと便利に使えるように努力していきます！
ありがとうございました！！！

お礼日時：2016/01/23 00:02