filterweitergabe per loop zum auslösen makro

Hallo zusammen,
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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Frank,
Wo hinterlege ich hier die Liste für die Übergabe an den ersten Filter?
Für den 1. Durchlauf holt sich das Makro die Filterwerte und den Dateinamen im Blatt "Filtertabelle" aus dem Zellbereich A1:A7, im 2. aus B1:B7 und so weiter. Das hatte ich im Kommentar aber auch schon geschrieben. Den Zellbereich kann man natürlich mit ein paar Modifikationen im Code anpassen. Die Werte sollten aber möglichst in einem zusammenhängenden Zellbereich stehen.
Das Makro übernimmt jetzt alle Inhalte, auch Formeln, dies hab ich jetzt durch xlvaluesandnumberformats geändert, jetzt hab ich allerdings keine Zellformatierung mehr... Kann ich auchnur Werte und ALLE Formate übertragen?
Probier es mal so:

          'Daten kopieren
rngCopy.Copy Destination:=.Cells(1, 1)
'oder so
'Daten kopieren
rngCopy.Copy
.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
.Cells(1, 1).PasteSpecial Paste:=xlPasteValues

Die erste Methode ist die sinnvollere. Beim Kopieren von gefilterten Zellbereich fügt Excel automatisch nur Formate und Werte ein. Bei PasteSpecial musst man dies explizit angeben.
Das Makro hängt erhängt sich an der Stelle an der das Fenster in der neuen Datei eingefroren werden soll.
Ersetze Range("A2").Select durch ActiveSheet.Range("B2").Select
Du hast deinen Code scheinbar in einem Tabellenblatt-Modul stehen. Da müssen Zellen in anderen Blättern immer mit der vollständigen Referenz zum Worksheet-Objekt angegeben werden, in dem das Makro Aktionen ausführen soll.
Gruß
Franz

Beliebteste Forumthreads (12 Monate)

filterweitergabe per loop zum auslösen makro

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread