Office: Autofilter, Kopieren, Kriterium per VBA?

Moin,

ich möchte bestimmte arbeitschritte mittels vba automatisieren, leider fehlen mir die notwendigen kenntnisse und die such-funktion im forum und im netz hat mich auch nicht wirklich weitergberacht. ich hoffe ihr könnt mir bei folgendem helfen:

in tabelle1 stehen in den zellen a1,b1,c1,d1 die jeweiligen kriterien für den autofilter

in tabelle 2 stehen die daten die gefiltert werden sollen, die kriterien aus tabelle1 beziehen sich der reihenfolge nach auf die spalten b, d, e und f

die gefilterten daten sollen dann in ein neues tabellenblatt kopiert werden

wie lässt sich dieser prozess ber vba automatisieren?

es wäre auch wichtig, dass die prozedur abläuft, wenn z.b nur ein oder zwei kriterienfelder in tabelle1 vorgegeben werden.

danke für eure hilfe und einen schönen sonntag noch

jens

:)

 

Moin, jens,

ohne VBA würde ich es per Spezialfilter lösen, indem dieser auf der Zieltabelle begonnen wird und die Angaben dann von den beiden anderen Blättern angegeben werden.

Per VBA: entweder eine Prozedur an eine Schaltfläche binden, die zu Beginn die Vollständigkeit der Angaben prüft, dann die Kriterien setzt (ist der Autofilter bereits aktiv, soll er gesetzt oder danach wieder aufgehoben werden), anschließend die sichtbaren Zellen per Copy auf den Zielbereich.


Ja, sicherlich. Die Grundaufzeichnung per MakroRekorder muss aber zwingend überarbeitet werden - liefert aber hier, wenn per F5/Inhalte/nur sichtbare Zellen gearbeitet wird, ein relativ gutes Grundgerüst.

 

Moin jinx,

ich habe mich mal mit dem recorder versucht:

Sub FilternKopieren()
Sheets("Tabelle2").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="=1076*", Operator:=xlOr, _
Criteria2:="=1085*"
Selection.AutoFilter Field:=16, Criteria1:="0002"
Sheets("Tabelle2").Select
Sheets("Tabelle2").Copy After:=Sheets(3)
Sheets("Tabelle2 (2)").Select
Sheets("Tabelle2 (2)").Name = "Ergebnis"
Sheets("Tabelle2").Select
Selection.AutoFilter
End Sub

leider entspricht dem ergenis längst nicht dem was ich will, so zum beispiel war es mir nicht möglich während der aufzeichnung einen bezug zu den kriterien in blatt1 herzustellen

wäre nett wenn du mir weiterhelfen könntest

p.s. "liefert aber hier, wenn per F5/Inhalte/nur sichtbare Zellen gearbeitet wird, ein relativ gutes Grundgerüst." - das verstehe ich nicht.

gruß jens *Smilie

 

Moin, jens,

eine Bereichszuweisung war ursprünglich nicht erwähnt. Vielleicht kann Dich der folgende Code etwas weiterbringen:

Code:

 

hallo jinx,

hab deinen code reinkopiert und das erste und vierte kriterium in tabelle 1 vorgegeben, kriterium 1 und kriterium 2 habe ich leer gelassen ...

nach dem ersten start wurde ein neues blatt angelegt, allerdings nur die Spaltenüberschriften übertragen

beim zweiten startversuch kommt die meldung laufzeitfehler 1004

wo kann der fehler liegen ?

Danke und Gruß

Jens

 

... und beim "Debuggen" wird dann folgende zeile gelb unterlegt:

.AutoFilter Field:=4, Criteria1:=Sheets("Tabelle1").Range("C1")

Gruß Jens

 

tschuldigung bin selber drauf gekommen, beim zweiten versuch kam die fehlermeldung weil der filter noch aktiv war, aber das erste problem besteht weiter, es werden nur die überschriften kopiert ....im übrigen sind die spalten den wo ich die kriterien frei gelassen habe beim autofilter auch aktiviert

Gruß Jens

 

Moin, jens,

tja, da hast Du allerdings recht - etwas nachgebessert sieht der Code dann so aus:

Code:

 

Hallo Jinx,

funktioniert alles hervorragend, herzlichen Dank ! *Smilie

Gruß Jens

 

Hallo Jinx,

ich habe den Code erweiter, so dass bestimmte spalten ausgeblendet werden aber z.b. die spalte d wird nicht ausgeblendet, dafür aber die spalten e,f - wieso ?

was muss eingefügt werden, damit das neue,kopierte blatt im querformat vorliegt ?

mein angepasster code:

Sub jens2()
With Sheets("Tabelle2")
With .Range("A1:Q1")
If Sheets("Tabelle2").AutoFilterMode Then .AutoFilter
.AutoFilter
If Sheets("Tabelle1").Range("A1").Value "" And Sheets("Tabelle1").Range("B1").Value "" Then
.AutoFilter Field:=1, Criteria1:=Sheets("Tabelle1").Range("A1").Value, Operator:=xlOr, _
Criteria2:=Sheets("Tabelle1").Range("B1").Value
End If
If Sheets("Tabelle1").Range("C1").Value "" Then
.AutoFilter Field:=9, Criteria1:=Sheets("Tabelle1").Range("C1")
End If
If Sheets("Tabelle1").Range("D1").Value "" Then
.AutoFilter Field:=10, Criteria1:=Sheets("Tabelle1").Range("D1")
End If
If Sheets("Tabelle1").Range("E1").Value "" Then
.AutoFilter Field:=16, Criteria1:=Sheets("Tabelle1").Range("E1")
End If
End With
.Range("A1").CurrentRegion.SpecialCells(xlVisible).Copy
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Gefilterte Daten_" & Right("000" & Worksheets.Count, 3)
Range("A1").Select ' IMHO redundant, da auf einer neuangelegten Tabelle immer A1 aktiv ist
ActiveCell.PasteSpecial Paste:=xlPasteAll
End With
Application.CutCopyMode = False
Columns("A:AA").Columns.AutoFit
Columns("B:B").EntireColumn.Hidden = True
Columns("D*biggrin.gif*").EntireColumn.Hidden = True
Columns("H:H").EntireColumn.Hidden = True
Columns("K:N").EntireColumn.Hidden = True
Columns("Q:AA").EntireColumn.Hidden = True
End Sub

Gruß Jens

 

Moin, Jens,

Dein angepasster Code passt nicht zur Beschreibung - und Spalte D wird bei mir ausgeblendet, wenn ich dort D:D einsetze.

Der Schluß könnte verkürzt werden auf

Code:

Anmerkung: auf die Anlage eines Blattes hast Du keinen Einfluß, es wird immer 256 Spalten breit und 65536 Zeilen hoch sein, wenn eine Version größer gleich Excel97 eingesetzt wird. Den Ausdruck im Querformat kann man wie oben ansetzen...

 

Hallo Jinx,

das mit dem d, kann vielleicht durch folgendes ausgelöst worden sein?

Sub jens2()
With Sheets("Tabelle2")
With .Range("A1:AA") an statt AA1 ???

jedenfalls funktioniert alles super !

das wars ersteinmal für heute,danke jinx und schönen abend noch !!!

gruß jens

 

Moin, Jens,

da ich nur das sehen kann, was hier im Forum veröffentlich wird (dort steht aber .Range("A1:Q1")), kann ich mir keine Mutmaßungen über Deinen angepassten und mir unbekannten Code leisten.

Du kannst durch die Verwendung von OPTION EXPLICIT (also einer erzwungenden Variablendeklaration) und des Punktes Debuggen / Komplilieren des VBA-Projektes allen Fehlern vor der eigentlichen Programmausführung "auf die Schliche" kommen. Ansonsten: Grüße zurück *wink.gif*

 

Hallo Jinx,

ich muss dich doch nochmal bitten auf meinen code zu schauen, ich heb jetzt festgestelt das die ersten beiden kriterien (tabelle1 a1, b1) beim ausführen der prozedur nicht berücksichtigt werden, obwohl werte eingetragen sind, mit den andern zwei kriterien läuft es problemlos - wenn man sich nach ablauf der prozedur die datenliste anschaut ist der autofilter in der Spalte 1 auch nicht aktiv ...

ich heb den fehler nicht gefunden, bitte schau nochmal nach

danke !

gruß jens *Smilie


Sub jens2()
With Sheets("Tabelle2")
With .Range("A1:AA1")
If Sheets("Tabelle2").AutoFilterMode Then .AutoFilter
.AutoFilter
If Sheets("Tabelle1").Range("A1").Value "" And Sheets("Tabelle1").Range("B1").Value "" Then
.AutoFilter Field:=1, Criteria1:=Sheets("Tabelle1").Range("A1").Value, Operator:=xlOr, _
Criteria2:=Sheets("Tabelle1").Range("B1").Value
End If
If Sheets("Tabelle1").Range("C1").Value "" Then
.AutoFilter Field:=9, Criteria1:=Sheets("Tabelle1").Range("C1")
End If
If Sheets("Tabelle1").Range("D1").Value "" Then
.AutoFilter Field:=10, Criteria1:=Sheets("Tabelle1").Range("D1")
End If
If Sheets("Tabelle1").Range("E1").Value "" Then
.AutoFilter Field:=16, Criteria1:=Sheets("Tabelle1").Range("E1")
End If
End With
.Range("A1").CurrentRegion.SpecialCells(xlVisible).Copy
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Gefilterte Daten_" & Right("000" & Worksheets.Count, 3)
Range("A1").Select ' IMHO redundant, da auf einer neuangelegten Tabelle immer A1 aktiv ist
ActiveCell.PasteSpecial Paste:=xlPasteAll
End With
Application.CutCopyMode = False
Columns("A:AA").Columns.AutoFit
Range("B:B,D*biggrin.gif*,E:E,F:F,H:H,K:N,P:AA").EntireColumn.Hidden = True
ActiveSheet.PageSetup.Orientation = xlLandscape
End Sub

 

Moin, Jens,

einige Dinge kann ich - aber nicht sehen, welche Eingaben auf Deiner Tabelle1 oder Tabelle2 stehen. Der Code hat beim letzten Mal bei mir und meiner Testmappe funktioniert, sonst hätte ich sicherlich schon laut aufgemuckt... Nur Du wirst den Fehler finden können, wenn Du uns nicht mitteilst, was in Tabelle1 bzw. Tabelle2 steht.