Usernamen in log Tabelle eintragen

Private Sub Workbook_Open()
'---- Tabellenblatt auswählen ----
Sheets("log").Select
Call Password_aktiv_no
' Variable zum Ermitteln der letzten belegten Zelle
Dim loLetzte As Long
With Worksheets("log")
'       letzte belegte Zelle in Spalte A
loLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, . _
Rows.Count)
If loLetzte = 103 Then
'           wenn bereits 99 Einträge vorhanden, dann letzte belegte Zelle = 1
loLetzte = 17
'           letzen 15 Einträge nach oben kopieren kopieren
Range("A89:D103").Select
Selection.Cut
Range("A3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'           Bereich 18:D103 löschen
.Range(.Cells(18, 1), .Cells(103, 4)).Clear
End If
'       in Spalte A Benutzernamen eintragen
.Cells(loLetzte + 1, 1).Value = Environ(UserName)
'       in Spalte C aktuelles Datum eintragen
.Cells(loLetzte + 1, 3).Value = Now
'       in Spalte D aktuelle Uhrzeit eintragen
.Cells(loLetzte + 1, 4).Value = Now
End With
Sheets("log").Select
Range("C18:C103").Select
Selection.NumberFormat = "m/d/yyyy"
Range("D18:D103").Select
Selection.NumberFormat = "[$-F400]h:mm:ss AM/PM"
Range("A18:D103").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("B3").Select
Selection.AutoFill Destination:=Range("B3:B103"), Type:=xlFillDefault
Range("B3:B103").Select
Range("A1").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFiltering:=True
ActiveWorkbook.Save
End Sub