背表紙を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
3