Sub CopyValues()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow As Long
Dim i As Long
Set ws1 = ThisWorkbook.Sheets("欲しいリスト")
Set ws2 = ThisWorkbook.Sheets("切り出しBXXX")
Set ws3 = ThisWorkbook.Sheets("切り出しBYYY")
最終行 = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
For i = 2 To 最終行
If ws1.Cells(i, "B").Value = "BXXX" Then
'番号
ws1.Cells(i, "B").Copy Destination:=ws2.Range("B2")
'日付
ws1.Cells(i, "A").Copy Destination:=ws2.Range("C2")
'指日
ws1.Range("H1").Copy Destination:=ws2.Range("D2")
'印刷
ws2.PrintOut
ws2.Range("B2").Value = ""
ws2.Range("C2").Value = ""
ElseIf ws1.Cells(i, "B").Value = "BYYY" Then
'番号
ws1.Cells(i, "B").Copy Destination:=ws3.Range("B2")
'日付
ws1.Cells(i, "A").Copy Destination:=ws3.Range("C2")
'指日
ws1.Range("H1").Copy Destination:=ws3.Range("D2")
'印刷
ws3.PrintOut
ws3.Range("B2").Value = ""
ws3.Range("C2").Value = ""
End If
Next i
End Sub