Sortieren über UF

Private Sub cmdOK_Click()
ActiveSheet.Unprotect
Dim lngLR As Long
With Sheets("Liste")    'Name evt. anpassen
lngLR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngLR, 1) = Me.txtFamilienname
.Cells(lngLR, 2) = Me.txtVorname
.Cells(lngLR, 3) = Me.txtAdresse
.Cells(lngLR, 4) = Me.txtOrt
.Cells(lngLR, 5) = Me.txtPLZ
.Cells(lngLR, 6) = Me.txtBundesland
.Cells(lngLR, 7) = Me.txtTelefonPrivat
.Cells(lngLR, 8) = Me.txtHandyPrivat
.Cells(lngLR, 9) = Me.txtTelefonFirma
.Cells(lngLR, 10) = Me.txtFax
.Cells(lngLR, 11) = Me.txtEmail
.Cells(lngLR, 12) = Me.txtWeb
.Cells(lngLR, 13) = Me.txtGeburtstag
End With
'erweiterung Textboxen leeren
Me.txtFamilienname = ""
Me.txtVorname = ""
Me.txtAdresse = ""
Me.txtOrt = ""
Me.txtPLZ = ""
Me.txtBundesland = ""
Me.txtTelefonPrivat = ""
Me.txtHandyPrivat = ""
Me.txtTelefonFirma = ""
Me.txtFax = ""
Me.txtEmail = ""
Me.txtWeb = ""
Me.txtGeburtstag = ""
Cells(lngLR, 1).Clear  ' Löscht den alten Eintrag
ActiveSheet.Protect
End Sub

'---Allg.Modul mit Recorder für Tab.Blatt "Liste" ---
Sub Sortieren()
Application.ScreenUpdating = False
Columns("A:M").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A1").Select
Dim i
For i = 2 To 998
Rows(i).Select
With Selection.Interior
.ColorIndex = 19
.Pattern = xlSolid
End With
i = i + 1
Next i
Application.ScreenUpdating = True
End Sub