結局、担当IDシートとデータシートのIDを照合するより、
データシートにあるだけのIDを個々に抽出して印刷すれば、
いいのかなと思いました。
プリントアウト用シートは印刷範囲が指定されているとし、
個々のシート名は変更して下さい。
Sub test()
Dim Dic As Object
Dim ws1 As Worksheet, ws2 As Worksheet
Dim r As Range, rr As Range
Dim r2 As Range
Dim key
Dim i As Long
Set Dic = CreateObject("Scripting.Dictionary")
Set ws1 = Worksheets("Sheet1") 'データシート
Set ws2 = Worksheets("Sheet2") 'プリントアウト用シート
Set r2 = ws2.Range("A4")
With ws1
For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
If Not Dic.exists(.Range("A" & i).Text) Then
Dic(.Range("A" & i).Text) = Empty
End If
Next
Set r = .Range("A1", .Cells(Rows.Count, "I").End(xlUp))
For Each key In Dic.keys
r.AutoFilter
r.AutoFilter 1, key
Set rr = .Range("A2", .Cells(Rows.Count, "I").End(xlUp)).SpecialCells(xlCellTypeVisible)
ws2.Range("A4:I28").ClearContents
rr.Copy
r2.PasteSpecial xlPasteValues
ws2.PrintOut Preview:=True 'プレビューがいらなければ、Preview:=True 削除
r.AutoFilter
If MsgBox("続けますか", vbOKCancel) = vbCancel Then Exit Sub '不要であれば削除願います
Next
End With
End Sub
ご参考まで。
お礼
有難うございました。 イメージ通りのものが出来ました。 あとは微調整をして運用させたいと思います。 コードの内容を確認して勉強させていただきます。 ホントに有難うございました。