|
こんな感じで、どうでしょーか ?
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
|
|