Hallo, wie kann ein Makro (VBA) erstellen, dass per Autofilter Zeilen mit einen bestimmten Kriterium filtert und anschließend in einen anderen Reiter kopiert?

Ok, hier eine Lösung für dich. Ich versuche es dir jetzt Schritt für Schritt zu erklären und hänge am Schluß auch deine Musterdatei wo das ganze drin ist mit ran:

1. Nach dem öffnen deiner Datei gehst du bitte mit der Tastenkombination ALT+F11 in den VBA Modus, jetzt gehst du links in der Auteilung auf Diese Arbeitsmappe und dort ein rechtsklick und auf Einfügen und da weiter auf Modul.

In dieses neue Fenster rechts trägst du bitte folgenden Code ein:

Sub übertragen()
Dim LoLetzte As Long
Dim LoI As Long
Dim lngLetzte As Long
Dim leereZeile
With Application        
.ScreenUpdating = False        
.EnableEvents = False        
.Calculation = xlCalculationManual
End WithSheets("Sheet1").Select
ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=2, Criteria1:= _        
"Email"   
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows.Count)   
Range("A2:B" & lngLetzte).Copy  
Sheets("Sheet2").Select
leereZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("A" & leereZeile & ":A" & leereZeile).Select
ActiveSheet.Paste   
With Application        
.ScreenUpdating = True        
.EnableEvents = True        
.Calculation = xlCalculationAutomatic
End With
Sheets("Sheet1").Select
ActiveSheet.ListObjects("Table2").Range.AutoFilter Field:=2    
Sheets("Sheet2").Select
End Sub

Wenn du das hast gehst du oben auf die Diskette um das ganze zu speichern. Jetzt bekommst du eine Meldung, da gehst du auf nein und speicherst im neuen Fenster deine Datei als xlsm Datei (Excel-Arbeitsmappe mit Makros). Dieses Fenster kannst du jetzt einfach schließen, sodass du wieder in deiner Tabelle (Sheet1) bist.

2. Gehe bitte in Sheet1 oben über den Reiter Entwicklertools und dort füge über Einfügen oben die erste Schaltfläche in deine Tabelle ein. Sobald du die Schaltfläche angelegt hast geht ein neues Fenster auf, dort wählst du das Makro übertragen aus und schließt es mit OK ab.

Jetzt brauchst du nurnoch deine Datei erneut oben über die Diskette speichern.

Nun wird über einen Klick auf die Schaltfläche automatisch das Sheet1 nach "Email" gefiltert und alles was jetzt stehen bleibt wird in Sheet2 in die nächste freie Zeile geschrieben.

Danach wird der Filter in Sheet1 wieder zurückgesetzt, sodass alles wieder sichtbar ist.

Hier noch deine Musterdatei zurück, hier ist die Schaltfläche und der Code im Modul eingebaut.

http://workupload.com/file/8NqahKCR

Kommst du damit klar?

Sehr schöne Fleißarbeit !

Aber aus:

End WithSheets("Sheet1").Select

sollte entweder


End With : Sheets("Sheet1").Select

oder

End With
Sheets("Sheet1").Select

werden.

Gruß aus Berlin


Hey Britzcontrol,

du hast natürlich Recht, danke für den Hinweis.

Es sollte

End With
Sheets("Sheet1").Select

sein.

Um einen Code zu Posten ist der Editor hier echt nicht der beste, jedesmal muss man die Codes alle wieder aufteilen.

Vielen Dank erstmal für die hilfreiche Antwort :) Allerdings bekomme ich immer noch folgenden Fehlercode: We can't paste because the Copy area and paste aren't the same size. Woran könnte das liegen?

Ich arbeite an einem Browser-AddOn, der den Editor verbessern soll. Wenn du willst, kannst du ihn betatesten, wenn es soweit ist.

Ich versuche, den Code beim hineinkopieren nicht zu verunstalten.

Komisch, könntest du mir deine Original Datei per Email an schmiddi.gf@gmail.com senden? Warum er das jetzt bei dir macht ist für mich so aus dem Kopf nicht nachvollziehbar.

Außer beim Einbau ist eventuell eine unachtsamkeit pasiert.

Sehr gerne:))

Es ist egal wie ich ihn einfüge immer ist der Mist zusammengequetscht.

Was ich mir noch vorstellen könnte: Der Fehler sagt ja aus das die beiden Bereiche nicht die selbe größe haben und es deshalb dort nicht eingefügt werden kann. Kann es sein das dein Original vom Aufbau her von deiner Musterdatei abweicht. Wie gasagt sonst bleibt nur der Blick in die Datei.

Vielen Dank für das Angebot, aber leider sind das vertrauliche Kundendaten :-/ ich habe schon den ganzen Inhalt im zweiten Sheet gelöscht. Angepasst habe ich nur die Namen Sheet1 und Sheet2. Oder hätte ich da noch mehr angleichen müssen?

Naja, das ist ja nicht das Problem. Es geht ja rein um die Daten in Spalte A und B, hättest du da nicht einfach eine Kopie deiner Datei machen können und die Kundendaten dann in der Kopie einfach raus löschen und Dummydaten eintragen können. So kann ich dir leider nicht genau sagen wo das Problem liegt, irgendwas stimmt mit dem Einfügebereich nicht.

Also ich habe jetzt einfach alles in die Musterdatei kopiert und jetzt geht es - danke :-) Eine Frage noch: wenn ich aus Versehen zwei Mal auf Refresh drücke, fängt es an, unter den vorhandenen Daten die gleichen Sätze nocheinmal zu kopieren. Kann man es so einstellen, dass er nachdem er einmal den Datensatz kopiert hat, wieder bei A2 von Sheet2 anfängt?

Du meinst das die Daten die du in Sheet2 kopieren willst immer ab A2 eingetragen werden sollen und nicht unten ran sollen?

Ja genau

OK, dann ersetze im Modul die Zeilen:

Sheets("Sheet2").Select
leereZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Range("A" & leereZeile & ":A" & leereZeile).Select
ActiveSheet.Paste

mit

Sheets("Sheet2").Select
Range("A2").Select
ActiveSheet.Paste

Danke für die super schnelle Antwort, werde es gleich probieren :)))

Hat alles geklappt - vielen lieben Dank noch mal für die viele Mühe :-)

Kein Thema, bitte gerne :))