Private Sub Add_And_SynchronizeName()
    iNewName$ = "Archive" 'укажите своё имя листа
    With ThisWorkbook
         If Not .ProtectStructure Then
            .Worksheets.Add.Name = iNewName$
            With .VBProject.VBComponents
                 .Item(.Count).Name = iNewName$
            End With
         Else
            MsgBox "В рабочей книге : " & .Name & vbCrLf & _
            "невозможно создание нового листа", vbCritical, ""
         End If
    End With
End Sub

Private Sub Add_And_SynchronizeName2()
    iNewName$ = "Archive2" 'укажите своё имя листа
    With ThisWorkbook
         If Not .ProtectStructure Then
            Dim iWorksheet As Worksheet
            Set iWorksheet = .Worksheets.Add
            iWorksheet.Name = iNewName$
 
            Dim iVBComponents As Object
            Set iVBComponents = .VBProject.VBComponents
            iVBComponents(iWorksheet.CodeName).Name = iNewName$
         Else
            MsgBox "В рабочей книге : " & .Name & vbCrLf & _
            "невозможно создание нового листа", vbCritical, ""
         End If
    End With
End Sub