AW: oder...
27.03.2019 15:19:38
UweD
Hallo nochmal
dann müssen die Tabellenblätter einzeln sortiert werden.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KName As String, NName As String, Arr, x As Integer, y As Integer
If Not Intersect(Range("A:A"), Target) Is Nothing Then
If Target.Row > 2 Then
KName = WorksheetFunction.Proper(Target.Value) 'je ester Buchstabe groß, Wichtig für Blattsortiereung
'Nachname ermitteln
Arr = Split(KName, ",")
NName = Arr(0)
'prüfen ob Blatt schon existiert
If IsError(Evaluate(NName & "!A1")) Then
'Wenn noch nicht da, dann Master ans Ende kopieren
Sheets("Master").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
'Blatt benennen
.Name = NName
'Name in F1
.Range("F1") = Target.Value
End With
'Link zum Blatt anlegen
With Sheets("Mitarbeiter")
.Hyperlinks.Add Anchor:=Target.Cells, Address:="", _
SubAddress:=NName & "!A1", TextToDisplay:=KName
'Tabelle sortieren
With .ListObjects("tblMitarbeiter").Sort
.SortFields.Clear
.SortFields.Add2 Key:=Range("tblMitarbeiter[[#All],[Mitarbeiter]]"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Blätter sortieren ab Nr. 4
For x = 4 To ActiveWorkbook.Sheets.Count
For y = x To ActiveWorkbook.Sheets.Count
If Sheets(y).Name < Sheets(x).Name Then
Sheets(y).Move Before:=Sheets(x)
End If
Next y
Next x
'Blatt Mitarbeiter auswählen
.Activate
End With
End If
End If
End If
End Sub
LG UweD