Makro Listeneinträge filtern/ kopieren

Hallo,
erst mal vielen Dank, falls das hier jemand lesen sollte.
Ich habe eine Tabelle in der in den Spalten D bis Y Einträge vorhanden sind. In Spalte C davor sind Namen eingetragen, die die jeweiligen Einträge der Spalten D bis Y einer Person zuordenen.
So sind beispielsweise die ersten 50 Einträge in Spalte C mit dem Namen "Hansdampf", dann 32 mit dem Namen "Schmalkraut", 16 mit "Kercke" usw.
Ich würde gerne via Makro alle Namen filtern, die in einer Liste stehen (diese ist in einem Extra Blatt in Spalte A), sodass falls Hansdampf der erste Eintrag auf der Liste wäre, die Spalte C nach diesem Namen gefiltert wird und im Anschluss der gesamte Bereich aller Einträge mit dem Namen Hansdampf, dann von C1 bis Spalte Y? kopiert und in ein Blatt eingefügt wird, welches den Namen Hansdampf trägt (Ich würde vorher für jeden Listeneintrag ein Blatt erstellen).
Meine VBA Kenntnisse gehen leider gegen Null, sodass wohl eine größere Hilfe notwendig ist.
Wie ich den Autofilter starte und ihn nach einem Kriterium filtern lasse (Welches hier provisorisch in "A1" eingetragen wurde, habe ich schon mal
Range("C1:Y1").AutoFilter Field:=1, Criteria1:=Range("A1")
Vielen Dank falls sich jemand hiermit beschäftigen möchte und mir helfen kann.
Bei Bedarf kann ich eine Beispiel Datei erstellen

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Jonathan,
etwa so - ein paar Anpassungen musst du noch machen.
LF
Franz

Sub Copy_Daten_zu_Namen()
Dim wksListe As Worksheet, zei_L As Long, sName As String
Dim wksData As Worksheet, rngData As Range, zei_D As Long
Dim wksName As Worksheet, zei_N As Long
Dim wkbA As Workbook
Set wkbA = ActiveWorkbook
Set wksListe = wkbA.Worksheets("ListeNamen")    'anpassen!!
Set wksData = wkbA.Worksheets("Tabelle14")      'anpassen
With wksData
'Zeile mit letztem Namen in Spalte C
zei_D = .Cells(.Rows.Count, 3).End(xlUp).Row
'Zellbereich mit den Daten in Spalten C:Y
Set rngData = .Range(.Cells(1, 3), .Cells(zei_D, 25))
'AUtofilter vorbereiten
If .AutoFilterMode = True Then .AutoFilterMode = False
rngData.AutoFilter
With wksListe
'Liste der Namen ab Zeile 2 im Blatt abarbeiten
For zei_L = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
sName = .Cells(zei_L, 1).Text
'Prüfeung ob das Blatt zum Namen vorhanden ist
If fncCheckSheetName(sName) = True Then
'Daten nach Name filtern
rngData.AutoFilter Field:=1, Criteria1:=sName
'Zielblatt setzen
Set wksName = wkbA.Worksheets(sName)
zei_N = 1 'Einfügezeile im Blatt zum Namen, Einfügespalte = 1 (A)
rngData.Copy wksName.Cells(zei_N, 1)
Else
MsgBox "für Name """ & sName & """ ist kein Blatt angelegt!"
End If
Next
End With
If .FilterMode = True Then .ShowAllData
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Makro Listeneinträge filtern/ kopieren

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread