Code erklären

Sub FilternUndDrucken() Dim arr() Dim iRow As Integer Range("A:A").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=Range("J1"), 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 zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub FilternUndDrucken() Dim arr() 'Datenfeld Dim iRow As Integer 'Zähler 'Spezialfilter setzen + Ausprägungen in Spalte "J" ausgeben Range("A:A").AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=Range("J1"), Unique:=True iRow = 2 'iRow initialisieren 'alle Daten der Spalte 4 in Datenfeld speichern Do Until IsEmpty(Cells(iRow, 4)) ReDim Preserve arr(iRow - 1) arr(iRow - 1) = Cells(iRow, 4) iRow = iRow + 1 Loop Columns(4).ClearContents 'Inhalte der Spalte 4 löschen 'alle im Datenfeld gespeichtern Werte als Filter in Spalte 1 setzen 'Anmerkung: 'das macht natürlich nur Sinn, wenn Spalte 4 Daten enthielt, 'die in Spalte 1 auftauchen For iRow = 1 To UBound(arr) Columns(1).AutoFilter Field:=1, Criteria1:=arr(iRow) ActiveSheet.PrintPreview 'Druckvorschau Next iRow Range("A1").AutoFilter 'AutoFilter aus End Sub

Hallo B,
der Fehler des Makros liegt darin,
dass die Werte aus Spalte 4 als Filter in Spalte 1 gesetzt werden,
und dann die Druckvorschau erscheint.
Tatsächlich sollen es aber die Werte aus Spalte 10 sein.
Versuch's mal damit + gib Laut, ob's klappt.
Herzliche Grüße
Rolf


Sub FilternUndDrucken()
Dim arr()                                    'Datenfeld
Dim iRow As Integer                          'Zähler
Dim sp As Integer                            'tempor.Spalte
sp = 10                                      'Spalte 10 als Zwischenspeicher
'Spezialfilter setzen + Ausprägungen in Spalte "J" ausgeben
Range("A:A").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("J1"), Unique:=True
iRow = 2                                     'iRow initialisieren
'alle Daten der Spalte 10 in Datenfeld speichern
Do Until IsEmpty(Cells(iRow, sp))
ReDim Preserve arr(iRow - 1)
arr(iRow - 1) = Cells(iRow, sp)
iRow = iRow + 1
Loop
Columns(sp).ClearContents                     'Inhalte der Spalte 10 löschen
'alle im Datenfeld gespeichtern Werte als Filter in Spalte 1 setzen
For iRow = 1 To UBound(arr)
Columns(1).AutoFilter Field:=1, Criteria1:=arr(iRow)
ActiveSheet.PrintPreview                  'Druckvorschau
Next iRow
Range("A1").AutoFilter                       'AutoFilter aus
End Sub

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread