Unprotect sheet, insert data, re-protect sheet

[CSS2018]

I have a macro that will create a new employee sheet, copied from a hidden sheet, and pulls in information based on the employee name and number they input.

My problem is it does not pull in their name (based on input box) on the newly created sheet. I need some help unlocking the sheet, pulling in the name of the employee (to A5), and re-locking it. See bold.

Sub CopySheet()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    Dim MySheetName As String
    MySheetName = InputBox("Enter Employee Name:" & vbCrLf & "[Firstname Lastname]", "", "")
    If MySheetName = "" Then
        MsgBox "No sheet name was entered."
        Exit Sub
        
    Else
        On Error Resume Next
        Dim EmployeeNumber As Variant
        EmployeeNumber = InputBox("Please enter employee number.", "", "")
        
        Set ws = Sheets(MySheetName)
        If Err.Number <> 0 Then
            Sheets("COPYME").Visible = True
            Sheets("COPYME").Copy After:=Sheets("PROJECT SUMMARY")
            ActiveSheet.Name = MySheetName
            Sheet4.Unprotect Password:="PassworD"
            Range("A5").Value = MySheetName
            Sheet4.Protect Password:="PassworD"
            Sheets("COPYME").Visible = xlVeryHidden
        Else
            MsgBox "Worksheet " & MySheetName & " already exists."
            Exit Sub
            
        End If
           Worksheets("Project Summary").Activate
           Rows("11:11").Select
           Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
           Range("B11").Value = MySheetName
           Range("C11").Value = EmployeeNumber
           Range("D11").Formula = "=INDIRECT(""'""&B11&""'!P3"")"
           Range("E11").Formula = "=INDIRECT(""'""&B11&""'!Q3"")"
           Range("F11").Formula = "=INDIRECT(""'""&B11&""'!P42"")"
    
    
    Range("B11").Select
    ActiveWorkbook.Worksheets("Project Summary").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Project Summary").Sort.SortFields.Add Key:=Range( _
        "B11"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Project Summary").Sort
        .SetRange Range("B11:F999")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    End If
    
    
    Application.ScreenUpdating = True
End Sub