ExcelからExcelへ差し込み印刷 Excelだけで差し込み印刷

Excelだけで「差し込み印刷」できるマクロを作ります

仕事で、Word+Excelの差し込み印刷を聞かれたのですが、手順が多すぎて、なんとかしたいなと思い、作成した備忘録です。
ついでに、年賀はがきの表書きを作ってみました。

###検索すると色々見つかります
https://engi.cocolog-nifty.com/sirenai/2014/07/vba-f817.html

https://mokomokomomoko.com/excel_macro_print/
様式だけお借りします。

###これが良かった
http://engi-seishi.la.coocan.jp/excel_sample.htm#etc
の　Excel宛名シール印刷（ヨコ3面タテ7面=21面タックシール用のみ）

##これを改造してみます。(作者様、無断でごめんなさい）
印刷　する/しない　列を追加、敬称も追加

printSheetをマクロで直接貼り付けしていたのを、このシートへ貼り付けに変更
このシートのタイトル列と行数分だけコピーして、印刷動作へ、これをdataシートの最後まで繰り返す
例えば、１シート４枚なら、４行にして、printSheetの様式変更に対応

印刷用シート、printDataシートにたいして式　例：=PrintData!E2　でデータを転記
なので、同じものを４件印刷する場合は、printSheetで対応可能

マクロの中で使っている名前の定義はこの２件

#マクロ
備忘録です。これで全部

Module1

Option Explicit

Sub 宛名シール印刷()
    Dim cHead As Integer    ' printDataテーブルの列数
    Dim cRows As Integer    ' printDataテーブルの行数
    cHead = Worksheets("printData").Range("TBL_printData").ListObject.HeaderRowRange.Count
    cRows = Worksheets("printData").Range("TBL_printData").ListObject.ListRows.Count
    
    Dim iData As Long       ' data処理行
    Dim iPData As Long      ' printData処理行
    Dim jPData As Long      ' printData処理列
    Dim rngData As Range    ' dataのrange
    Dim rngPData As Range   ' printDataのrange
    
    printDataClear          'sheet[printData]の名前[TBL_printData]範囲をクリア
    
    iData = 0
    iPData = 0
    Set rngData = Worksheets("data").Range("A5")       '処理開始位置
    Set rngPData = Worksheets("printData").Range("B1") '処理開始位置
        
    Do Until rngData.Offset(iData, 0).Value = ""
        If rngData.Offset(iData, 0).Value = "する" Then
            iPData = iPData + 1
            For jPData = 1 To cHead
                rngPData.Offset(iPData, jPData - 1) = rngData.Offset(iData, jPData - 1)
            Next
            If iPData > (cRows - 1) Then
                実印刷
                printDataClear   'sheet[printData]の名前[TBL_printData]範囲をクリア
                iPData = 0
                Worksheets("data").Select
            End If
        End If
        iData = iData + 1
    Loop
    If iPData > 0 Then 実印刷
End Sub

' 宛先シール実印刷
Sub 実印刷()
    Sheets("printSheet").Select
    With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0#)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .Orientation = xlPortrait
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Zoom = 98
    End With
    
    Range("Print_Area").Select
    
    Select Case MsgBox(prompt:="印刷を続けますか？" & vbCrLf & "いいえ：プレビュー", Buttons:=vbYesNoCancel)
        Case vbYes
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
        Case vbNo
            ActiveWindow.SelectedSheets.PrintPreview
        Case Else
            Worksheets("data").Select
            End
    End Select
    Worksheets("data").Select
End Sub

'sheet[printData]の名前[printData]範囲をクリア
Sub printDataClear()
    Worksheets("printData").Range("TBL_printData").ClearContents
End Sub

#マクロそのままで
１ページ１枚様式もしてみました。
printDataシートとprintSheetシートの変更だけです。

物忘れ防止 宛名シールの印刷_２１面シール改.xlsm　差し込み印刷.xlsm
https://github.com/sugita0301/douzo

#年賀状印刷

住所録のテンプレートはここからいただきました。
https://www.microsoft.com/ja-jp/office/pipc/nengajo/05.aspx
年賀はがきのイメージは、スキャナで取り込むまたは、Wrodのウイザードでも入手できます。

こんな感じになります。