filterweitergabe per loop zum auslösen makro
28.05.2014 18:51:49
Frank
ich hab folgendes problem:
Ausgangssituation ist folgende ich habe eine große Tabelle, die in einem anderen Tabellenblatt diverse Auswahlfilter mit hinterlegten Listen per Gültigkeit mit definiertem Namen manuell ausgewählt werden. Diese Filter werden dann über ein Makro ausgelöst und kopieren den Inhalt aus diversen Spalten gefiltert nach den Eingaben im Tabellenblatt weiter in eine neue Arbeitsmappe und speichern diese über ein im Tabellen hinterlegten Namen ab. Das Funktioniert auch soweit alles ganz gut, ausser das es ziemlich langsam ist, und das Resultat von der Formatierung her nicht gut aussieht und die Dateien riesig werden weil immer ALLE Zeilen kopiert werden.
Das aber bei Seite, mein Problem ist jetzt, dass ich eine Auswahlliste generiere und über diese sämtliche hinterlegten Filterkriterien jeweils ein mal je Position der Auswahlliste ausführe.
Private Sub Button_Click()
Sheets("Ausgangstabelle").Select
Sheets("Ausgangstabelle").Range("$A:$Z").AutoFilter Field:=5, Criteria1:=Sheets(" _
Filtertabelle").Range("A1").Value 'Filter setzen
Sheets("Ausgangstabelle").Range("$A:$Z").AutoFilter Field:=4, Criteria1:=Sheets(" _
Filtertabelle").Range("A2").Value
Sheets("Ausgangstabelle").Range("$A:$Z").AutoFilter Field:=3, Criteria1:=Sheets(" _
Filtertabelle").Range("A3").Value
Sheets("Ausgangstabelle").Range("$A:$Z").AutoFilter Field:=2, Criteria1:=Sheets(" _
Filtertabelle").Range("A4").Value
Sheets("Ausgangstabelle").Range("$A:$Z").AutoFilter Field:=1, Criteria1:=Sheets(" _
Filtertabelle").Range("A5").Value
Sheets("Ausgangstabelle").Range("A:A,C:C,F:F,G:G,:M,V:V,X:X,Z:Z ").Copy 'gefilterten Bereich _
kopieren
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
With Selection
.VerticalAlignment = xlTop
.Orientation = 0
.AddIndent = False
.ShrinkToFit = True
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWorkbook.SaveAs Filename:="H:\Auswertungen\" & Workbooks("Auswertung.xls").Worksheets(" _
Filtertabelle").Range("A7").Value & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Windows("Auswertung.xls").Activate
Sheets("Ausgangstabelle").Select
ActiveSheet.Range("$A:$Z").AutoFilter Field:=1 'Filter zurücksetzen
ActiveSheet.Range("$A:$Z").AutoFilter Field:=2
ActiveSheet.Range("$A:$Z").AutoFilter Field:=3
ActiveSheet.Range("$A:$Z").AutoFilter Field:=4
ActiveSheet.Range("$A:$Z").AutoFilter Field:=5
End Sub
Und genau hierrüber stolpere ich gerade:ich möchte, dass genau dieser Filter x-mal durch eine hinterlegte Liste ausgeführt wird, und die das restliche hinterlegte Makro im Loop lassen soll, d.h. x-mal die jeweilige Auswertung als eigene Datei ausspielt:
Sheets("Ausgangstabelle").Range("$A:$Z").AutoFilter Field:=5, Criteria1:=Sheets("Filtertabelle").Range("A1").Value 'Filter setzen
Kann mir jemand helfen?
Danke Euch
Gruß Frank