Namensliste auf Tabellenblätter auteilen

Hallo,
ich versuche, mehrere Listen nach den Namen zu sortieren.
Vielleicht weiß jemand Rat.
Ich habe mehrere Listen mit jeweils etwa 1500 Einträgen die nun nach Namen sortiert und in ein eigenes Tabellenblatt eingetragen werden sollen
Unser Verein besteht aus 23 Mitgliedern. Für jeden einzelnen habe ich nun ein Tabellenblatt mit dessen Namen angelegt.
Hier eine Musterdatei:
https://www.herber.de/bbs/user/58775.xls
Ich dachte mir, es gäbe vielleicht eine Möglichkeit, die Sortierarbeit durch ein Makro erledigen zu lassen.
Nicht, das es mir zuviel Arbeit wäre, die Liste zu filtern und die Ergebnisse auszuschneiden. Ich würde gerne wissen, wie es mit einem Makro funktioniert.
Ich habe schon versucht, mit dem Makrorecorder aufzuzeichnen, aber im Endeffekt bleibt es immer reine Handarbeit, jeden Namen einzeln auszuwählen.
Würde mich freuen, vor allem, weil ich diese Arbeit noch öfter machen werden muss.
Danke, für Eure Hilfe!
Judith

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Judth,
es gibt nur die Tabelle Auflistung. Ich habe es jtzt nicht überprüft, aber ich vermute es sins alle Dda.


Option Explicit
Sub Judith()
Dim LoLetzte As Long
Dim LoI As Long
Application.ScreenUpdating = False
LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
Range("A4:G" & LoLetzte).Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("D4"),  _
Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
With ActiveSheet
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = .Cells(4, 1) & " " & .Cells(4, 4)
.Rows("3:4").Copy Rows(1)
For LoI = 5 To LoLetzte
If .Cells(LoI, 1)  .Cells(LoI - 1) And .Cells(LoI, 4)  .Cells(LoI - 1, 4) Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = .Cells(LoI, 1) & " " & .Cells(LoI, 4)
.Rows("3").Copy Rows(1)
.Rows(LoI).Copy Rows(2)
End If
Next LoI
End With
Application.ScreenUpdating = False
End Sub

Gruß Hajo

Option Explicit Sub StartSort_Verteilung() Dim Bereich As Range, meZellen As Range Dim meArea Dim A As Long With Application .ScreenUpdating = False .EnableEvents = False With Sheets("Auflistung") Set Bereich = .Range("A4", .Cells.SpecialCells(xlCellTypeLastCell)) Bereich.Sort Bereich(1), xlAscending With Sheets("Vereinsmitglieder") meArea = .Range("A4", .Cells(.Rows.Count, 1).End(xlUp)) End With Set Bereich = .Range("A3", .Cells.SpecialCells(xlCellTypeLastCell)) For A = 1 To Ubound(meArea) If meArea(A, 1) <> "" Then Bereich.AutoFilter 1, meArea(A, 1) Set meZellen = Bereich.SpecialCells(xlCellTypeVisible) On Error Resume Next 'Sicherheit, sollte Tabelle nicht vorhanden sein meZellen.Copy Sheets(meArea(A, 1)).Range("A3") On Error GoTo 0 End If Next A Bereich.AutoFilter End With 'Sheets("Auflistung") .ScreenUpdating = True .EnableEvents = True End With ' Application End Sub

Beliebteste Forumthreads (12 Monate)

Namensliste auf Tabellenblätter auteilen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread