Thema: Tabelle nacheinander filtern und drucken

StandardModule: basMain

Sub FilternUndDrucken()
   Dim arr()
   Dim iRow As Integer
   Range("A:A").AdvancedFilter Action:=xlFilterCopy, _
      CopyToRange:=Range("D1"), Unique:=True
   iRow = 2
   Do Until IsEmpty(Cells(iRow, 4))
      ReDim Preserve arr(iRow - 1)
      arr(iRow - 1) = Cells(iRow, 4)
      iRow = iRow + 1
   Loop
   Columns(4).ClearContents
   For iRow = 1 To UBound(arr)
      Columns(1).AutoFilter Field:=1, Criteria1:=arr(iRow)
      ActiveSheet.PrintPreview
   Next iRow
   Range("A1").AutoFilter
End Sub

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Filtern