Sub SpeichernSortieren()
ActiveSheet.Protect UserInterfaceOnly:=True, Password:="***"
ActiveWorkbook.Worksheets("Schüler Liste").ListObjects("Tabelle1").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Schüler Liste").ListObjects("Tabelle1").Sort. _
SortFields.Add Key:=Range("Tabelle1[Ort]"), SortOn:=xlSortOnValues, Order _
:=xlAscending, CustomOrder:= _
"Krippe,Kindergarten,Vorschule,Klasse 1,Klasse 2,Klasse 3,Klasse 4,Klasse 5,Klasse 6,Klasse 7,Klasse 8,Klasse 9,Klasse 10" _
, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Schüler Liste").ListObjects("Tabelle1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim Datumzeitstempel As String
Dim Jetzt As Date
Jetzt = Now()
Dateiname = "Klassenliste Phone EMail"
Datumzeitstempel = Year(Date) & Format(Month(Date), "00") & Format(Day(Date), "00")
Datumzeitstempel = Dateiname & " " & Datumzeitstempel & "-" & Format(Hour(Jetzt), "00") & Format(Minute(Jetzt), "00") & Format(Second(Jetzt), "00")
ActiveWorkbook.SaveAs (ThisWorkbook.Path & "\" & Datumzeitstempel & ".xlsm")
End Sub