マクロ ループ印刷（？）について

質問

VBA初心者です。
データシート、プリントアウト用シート、担当IDシート(3文字の整数)があります。
プリントアウト用シートにデータシートから関数で担当ごとに抽出する（無い場合はゼロ「0」）ようにしてある場合で各担当ごとにプリントアウトするため、マクロでループを入れたいと思っています。
(1)プリントアウト用シートに担当IDを担当IDシートから代入する。
(2)担当IDシート（Cell(1,1)からIDです）を見て空白に（データがなくなるまで）なるまで(1)の処理を続ける
(3)データシートから抽出したデータがゼロ「0」でないときは印刷（ゼロのときは(2)に）
としたいのですが、どなたかコードと考え方を教えていただけないでしょうか？　宜しくお願いいたします。

回答No.3

n-jun · ベストアンサー

結局、担当ＩＤシートとデータシートのＩＤを照合するより、
データシートにあるだけのＩＤを個々に抽出して印刷すれば、
いいのかなと思いました。
プリントアウト用シートは印刷範囲が指定されているとし、
個々のシート名は変更して下さい。

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
ご参考まで。

お礼

有難うございました。
イメージ通りのものが出来ました。
あとは微調整をして運用させたいと思います。

コードの内容を確認して勉強させていただきます。
ホントに有難うございました。

回答No.2

n-jun

>是非、その方法でお願いします。
各シートのレイアウトの提示がないと、無理ですよ。

補足

大変失礼しました。
DatasheetにはA列～I列でA列に担当コードが入っています。
Printsheetには1～3行目までタイトルや項目名があり抽出データはA4：I28までの表となっております。
担当IDsheetはA1：A82まで今のところあります。
こんな感じで良いでしょうか？
お忙しいところ恐縮です。宜しくお願いします。

回答No.1

n-jun

・担当IDシートからＩＤを取得。
・データシートにそのＩＤに該当するデータ（０でない）があれば、プリントアウト用シートに転記し印刷する。
・そのＩＤのデータが０であるか、印刷を行なったら、次のＩＤを取得する。
・全てのＩＤを取得したら完了。

と言う事ではどうでしょう？

補足

早速のご返答有難うございます。
そうですね。その方が一般的すよね。
方法を模索しているうちに脱線してしまいました。
是非、その方法でお願いします。