| 
    
     |  | こんな感じで、どうでしょーか ? 
 Sub Test_Print()
 Dim MyR As Range, FlR As Range, C As Range
 Dim Pl As Long
 
 Set MyR = Range("A1").CurrentRegion
 Set FlR = Range("D1", Range("D65536").End(xlUp))
 FlR.AdvancedFilter xlFilterCopy, , Range("AA1"), True
 Application.ScreenUpdating = False
 Columns(4).Hidden = True
 On Error GoTo ErLine
 For Each C In Range("AA2", Range("AA65536").End(xlUp))
 Pl = WorksheetFunction.CountIf(FlR, C.Value)
 FlR.AutoFilter 1, C.Value
 MyR.PrintOut Copies:=Pl
 Next
 ErLine:
 Columns(4).Hidden = False
 ActiveSheet.AutoFilterMode = False
 Columns(27).ClearContents
 Application.ScreenUpdating = True
 Set MyR = Nothing: Set FlR = Nothing
 End Sub
 
 |  |