条件別印刷を教えてください。

質問

エクセルマクロで条件別で印刷をしたいのですが？
合格品、不合格品それぞれのォームで印刷する。
印刷ボタンを押し一覧表からデータ転記後印刷したい。
どうかよろしくお願いします。

印刷ボタンを押すとB列"合格品"表示を選び合格フォームで印刷する。"不合格品"ならば印刷しない。
印刷ボタンを押すとB列"不合格品"表示を選び不合格フォームで印刷する。"合格品"ならば印刷しない。

B列目の結果を判断しA3から空白セルまで連続印刷２種類とも、一度で無理ならボタン2個準備 可
"合格品" フォーム "不合格品" フォーム に一覧表から数値を転記。
sheet3に一覧表があります。
マクロの作成したのですが、うまくいきません。

sheet3 例
列/行 1 2 3 4 5 6 7 8 9 10 ..... 13 14 15 16
A2 製番 合否 種類 型式 開始 終了
A3 001 合 AA 123 1/7 1/15
A4 002 合 BB 456 1/8 1/16
A5 003 不 CC 789 1/9 1/12
・
・
A22 020 合 TT 999 1/7 1/15

Worksheets("sheet3").Activate

Range("A3").Select '開始セル製造番号
'ループXの開始
Do
'アクティブセルを１つ下に移動
ActiveCell.Offset(1, 0).Select
If oSht.Cells(idx, 3) = "合格品" Then
' 繰り返し処理
End If
'空欄であれば、プログラムを終了する
'Trim関数は前後のスペースを消去する
If Trim(ActiveCell.Value) = "" Then
Exit Do
End If

'非表示セルは印刷の対象としない
If ActiveCell.EntireRow.Hidden = False Then
'これ以降、すべて印刷用シート
With Worksheets("合格品")

'レコードの先頭セルを選択
.Range("C3").Value = ActiveCell.Offset(0, 0).Value '製造番号
.Range("L24").Value = ActiveCell.Offset(0, 2).Value '種類
.Range("F3").Value = ActiveCell.Offset(0, 3).Value '型式
.Range("C14").Value = ActiveCell.Offset(0, 4).Value '開始日
.Range("C15").Value = ActiveCell.Offset(0, 5).Value '終了日
'レコードの最終セルであれば、１部印刷を実行する
.PrintOut

'印刷用シート終了
End With

回答No.2

keithin

＃ご相談で説明されていませんが、合否それぞれのシートでレイアウトは同一だとして。
＃それからご相談の情報提供が間違って？いますが、Ｂ列には「合」「否」じゃなく「合格品」「不合格品」と記入されていて、それぞれを「合格品」シートと「不合格品」シートで印刷するのだとして。

sub macro1()
　dim r as long

　worksheets("Sheet3").select
　for r = 3 to range("A65536").end(xlup).row

’ご相談で説明されていないＡ列の実際の内容に対する保険として
　if trim(cells(r, "A")) = "" then exit sub

　if not cells(r, "A").entirerow.hidden then

　with worksheets(cells(r, "B").value)　’合否
　.Range("C3").Value = cells(r, "A").Value '製造番号
’　この辺りから列位置が不明瞭なのでキチンと修正の事
　.Range("L24").Value = cells(r, "C").Value '種類
　.Range("F3").Value = cells(r, "D").Value '型式
　.Range("C14").Value = cells(r, "E").Value '開始日
　.Range("C15").Value = cells(r, "F").Value '終了日
　.Range("C6").Value = cells(r, "G").Value '工程1担当
　.Range("C7").Value = cells(r, "H").Value '工程2担当
　.Range("C9").Value = cells(r, "I").Value '外観
　.Range("C10").Value = cells(r, "J").Value '気密
　.Range("C11").Value = cells(r, "K").Value '初期MIN
　.Range("C12").Value = cells(r, "L").Value '初期MAX
　.Range("C13").Value = cells(r, "M").Value '終期MIN
　.Range("C14").Value = cells(r, "N").Value '終期MAX

　.PrintOut

　end with
　end if
　next r
end sub

前のご相談をほっぽらかして新しいご相談を出しなおしたってことは、何がしたいんですか？
前のご相談は、忘れずに解決で閉じる操作をキチンとしといてください。

お礼

ご指摘のとおり申し訳ありません。今後注意します。
有難うございました。

回答No.1

K Kazz（@JazzCorp）

Option Explicit
Sub ReallyRag()
Dam fool
Worksheets("sheet3").Activate
Range("A3").Select '開始セル製造番号
'ループXの開始
Do
'アクティブセルを１つ下に移動
ActiveCell.Offset(1, 0).Select
If oSht.Cells(idx, 3) = "合格品" Then
' 繰り返し処理
End If
'空欄であれば、プログラムを終了する
'Trim関数は前後のスペースを消去する
If Trim(ActiveCell.Value) = "" Then
Exit Do
End If
'非表示セルは印刷の対象としない
If ActiveCell.EntireRow.Hidden = False Then
'これ以降、すべて印刷用シート
With Worksheets("合格品")
'レコードの先頭セルを選択
.Range("C3").Value = ActiveCell.Offset(0, 0).Value '製造番号
.Range("L24").Value = ActiveCell.Offset(0, 2).Value '種類
.Range("F3").Value = ActiveCell.Offset(0, 3).Value '型式
.Range("C14").Value = ActiveCell.Offset(0, 4).Value '開始日
.Range("C15").Value = ActiveCell.Offset(0, 5).Value '終了日
'レコードの最終セルであれば、１部印刷を実行する
.PrintOut
'印刷用シート終了
End With
End If
Loop
End Sub

お礼

有難うございます。助かりました。