AW: Zellinhalte in Tabelle übernehmen, alphab. sort.
13.01.2015 17:22:53
fcs
Hallo Gerhard,
hier ein entsprechendes Makro, das bei Bedarf manuell/per Schaltfläche gestartet wird.
Wichtig ist, dass in den 5 Blättern zu Beginn die Namen sortiert sind und dass in allen Tabellen die gleichen Namen vorhanden sind. Danach kannst du dann in Tabelle1 am Ende Namen/Vornamen eingeben und per Makro diese in die anderen Blätter kopieren.
Sinvoller ist es jedoch, die Daten zu den Namen in einem Tabellenblatt zu verwalten und bei Bedarf einen Datenauszug zu generieren, oder durch einblenden/ausblenden von Spalten die gewünschten Daten anzuzeigen.
Gruß
Franz
Sub NeueNamen_einsortieren()
Dim wksMaster As Worksheet
Dim Zeile_LM As Long
Dim Zeile_1M As Long
Dim Zeile_LMV As Long
Dim wksZiel As Worksheet
Dim intZ As Integer
Dim Zeile_1Z As Long
Dim Zeile_LZ As Long
'Master-/Eingabeblatt
Set wksMaster = ActiveWorkbook.Worksheets("Tabelle1") 'ggf. Name anpassen
With wksMaster
Zeile_1M = 2 '1. Zeile mit Namens-Eintrag ggf. anpassen
Zeile_LM = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For intZ = 2 To 5
Select Case intZ
'in den Case-Zeilen ggf. den Blattnamen und die 1. Zeile mit Namens-Eintrag anpassen
Case 2: Set wksZiel = ActiveWorkbook.Sheets("Tabelle2"): Zeile_1Z = 2
Case 3: Set wksZiel = ActiveWorkbook.Sheets("Tabelle3"): Zeile_1Z = 2
Case 4: Set wksZiel = ActiveWorkbook.Sheets("Tabelle4"): Zeile_1Z = 2
Case 5: Set wksZiel = ActiveWorkbook.Sheets("Tabelle5"): Zeile_1Z = 2
End Select
With wksZiel
'Letzte Zeile im Zielblatt
Zeile_LZ = .Cells(.Rows.Count, 1).End(xlUp).Row
'vorherige letzte Zeile im Masterblatt
Zeile_LMV = Zeile_1M + (Zeile_LZ - Zeile_1Z)
'Prüfen, ob Name und Vorname in letzter Zeile im Zielblatt und in vorheriger _
letzter Zeile im Masterblatt übereinstimmen.
If .Cells(Zeile_LZ, 1).Text = wksMaster.Cells(Zeile_LMV, 1).Text _
And .Cells(Zeile_LZ, 2).Text = wksMaster.Cells(Zeile_LMV, 2).Text Then
'Prüfen, ob im Master-Blatt die Nummer der letzten Zeile größer als die der _
vorherigen letzten Zeile ist.
If Zeile_LM > Zeile_LMV Then
'Neue Namen in A & B ins Zielblatt kopieren
With wksMaster
With .Range(.Cells(Zeile_LMV + 1, 1), .Cells(Zeile_LM, 2))
.Copy Destination:=wksZiel.Cells(Zeile_LZ + 1, 1)
End With
End With
End If
'neue letzte Zeile im Zielblatt
Zeile_LZ = .Cells(.Rows.Count, 1).End(xlUp).Row
If Zeile_LZ > Zeile_1Z Then
'Zielblatt sortieren
With .Range(.Rows(Zeile_1Z), .Rows(Zeile_LZ))
.Sort key1:=.Range("A1"), order1:=xlAscending, _
key2:=.Range("B1"), order2:=xlAscending, Header:=xlNo
End With
End If
Else
MsgBox "letzter Name/Vorname aus vorheriger Bearbeitung in den Tabellenblättern """ _
& wksMaster.Name & """ und """ & wksZiel.Name & """ stimmen nicht überein." _
& vbLf & "Makro wird abgebrochen!"
Exit Sub
End If
End With
Next
With wksMaster
If Zeile_LM > Zeile_1M Then
'Masterblatt sortieren
With .Range(.Rows(Zeile_1M), .Rows(Zeile_LM))
.Sort key1:=.Range("A1"), order1:=xlAscending, _
key2:=.Range("B1"), order2:=xlAscending, Header:=xlNo
End With
End If
End With
End Sub