背表紙を2枚セットで1ページに印刷その2

1 選択範囲をintersectでC列に限定しないで、Rows.Rowで掴むことで、無駄なmsgboxを減らした。ただし、1つの列に絞っていないので、同じ行のセルをわざわざCtrを押して離れて選択すると、Rows.rowは重複した行番号を返してしまう。これは無視した。

2コード

Sub 背表紙ラベル印刷_選択バージョン()
    'Sh1:データシート、Sh2:印刷シート
    Dim Sh1 As Worksheet: Set Sh1 = Sheets("Sheet1")
    Dim Sh2 As Worksheet: Set Sh2 = Sheets("Sheet2")
    With Sh1
        '初期化(Sh2はSh1のセルE6:E7を参照している)
        .Range("E6:E7").ClearContents
        '選択範囲の可視セルのうちの、行をtRows(targetRows)に格納
        Dim tRows As Range
        Set tRows = Selection.SpecialCells(xlCellTypeVisible).Rows
        
        '選択を同じ行で離れて(CTRキーを押してクリックして)選択すると
        'tRng.rowが同じ行番号を返してしまうが、そんなことしない前提
        Dim tRng As Range
        For Each tRng In tRows
            '出力用シートに転記済状態のデータ件数
            Dim inputCnt As Long
            Select Case inputCnt
                Case 0
                    .Range("E6").Value = .Range("D" & tRng.Row).Value
                    '1件転記した状態になったから
                    inputCnt = 1
                Case 1
                    .Range("E7").Value = .Range("D" & tRng.Row).Value
                    '2件転記した状態になったから印刷
                    Sh2.PrintOut preview:=True
                    '転記状態を空にする
                    .Range("E6:E7").ClearContents
                    '0件転記された状態になったから
                    inputCnt = 0
                Case Else
                    MsgBox "マクロの記述要確認"
            End Select
        Next
        '最後がぴったり2件埋まらない場合、最後の1件は印刷されていないので印刷
        If inputCnt = 1 Then
            Sh2.PrintOut preview:=True
        End If
    End With
End Sub