Automatic filter and print

[marreco]

how to reduce this code?

Sub FilterAndPrint()
   
    Dim ws As Worksheet
    Dim lastrow As Long
   
    Application.ScreenUpdating = False
    Set ws = ActiveSheet
        With ws
            lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
            .AutoFilterMode = False
            .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:="INTERNO"
            .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:="INTERNO 1"
            .PageSetup.PrintArea = ""
            .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
            '.PrintOut
            'Filter and print again
            .AutoFilterMode = False
            .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:="INTERNO"
            .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:="INTERNO 2"
            .PageSetup.PrintArea = ""
            .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
            '.PrintOut
            'Filter and print again
            .AutoFilterMode = False
            .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:="INTERNO"
            .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:="INTERNO 3"
            .PageSetup.PrintArea = ""
            .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
            '.PrintOut
            'Filter and print again
            .AutoFilterMode = False
            .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:="EXTERNO"
            .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:="EXTERNO 1"
            .PageSetup.PrintArea = ""
            .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
            '.PrintOut
            'Filter and print again
            .AutoFilterMode = False
            .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:="EXTERNO"
            .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:="EXTERNO 2"
            .PageSetup.PrintArea = ""
            .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
            '.PrintOut
            'Filter and print again
            .AutoFilterMode = False
            .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:="EXTERNO"
            .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:="EXTERNO 3"
            .PageSetup.PrintArea = ""
            .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
        End With
    Application.ScreenUpdating = True
   
End Sub

 

[vletm]

No sample file ... couldn't test so well.

Sub FilterAndPrint()
   
    Dim ws As Worksheet
    Dim lastrow As Long
   
    Application.ScreenUpdating = False
    Set ws = ActiveSheet
        With ws
            lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
           
            For ie = 1 To 2
                crit1 = "INTERNO"
                If ie = 2 Then crit1 = "EXTERNO"
                For ei = 1 To 3
            'Filter and print again
                    .AutoFilterMode = False
                    .Range("A4:H" & lastrow).AutoFilter field:=8, Criteria1:=crit1
                    .Range("A4:H" & lastrow).AutoFilter field:=2, Criteria1:=crit1 & " " & ei
                    .PageSetup.PrintArea = ""
                    .PageSetup.PrintArea = .Range("A4:H" & lastrow).Address
            '.PrintOut
                Next ei
            Next ie
           
        End With
    Application.ScreenUpdating = True
   
End Sub

 

[marreco]

Very nice

 

[vletm]

Always gotta compare the original and modified results ... I couldn't