Proteger libro con contraseña al activarse

Antes de ejecutar la siguiente macro tengo el libro con contraseña, y para que funcione lo tengo que desproteger, el problema esta en que una vez ejecutada la macro quisiera que volviera a protegerse el libro.

Option Explicit
'
Sub EXCELeINFOGuardarHojaComoArchivoNuevo()
'
ActiveWorkbook.Unprotect ("1q2w3er")
'Declaramos las variables.
Dim VentanasProtegidas As Boolean
Dim EstructuraProtegida As Boolean
Dim NombreHoja As String
Dim Confirmacion As String
Dim NombreArchivo As String
Dim GuardarComo As Variant
Dim Extension As String
'
'En caso de error.
On Error GoTo ErrorHandler
'
'Validamos si la ventana o la estructura del archivo están protegidos.
VentanasProtegidas = ActiveWorkbook.ProtectWindows
EstructuraProtegida = ActiveWorkbook.ProtectStructure
'
'En caso de estar protegidas mostramos mensaje.
If VentanasProtegidas = True Or EstructuraProtegida = True Then
MsgBox "No se puede ejecutar el comando cuando la estructura del archivo está protegida.", _
vbExclamation, "EXCELeINFO"
Else
'
'Copiamos la hoja y guardamos.
NombreHoja = ActiveSheet.Name
Confirmacion = MsgBox("Desea guardar la hoja '" & NombreHoja & "' como archivo nuevo?", _
vbQuestion + vbYesNo, "EXCELeINFO")
Application.ScreenUpdating = False
If Confirmacion = vbYes Then
ActiveSheet.Select
ActiveSheet.Copy
ActiveSheet.Protect ("1q2w3er")
NombreArchivo = ActiveWorkbook.Name
GuardarComo = Application.GetSaveAsFilename(InitialFileName:=NombreHoja, _
fileFilter:="Libro de Excel(*.xlsx), *.xlsx, Libro de Excel habilitado para macros(*.xlsm), *.xlsm, Libro de Excel 97-2003(*.xls), *.xls,CSV (delimitado por comas)(*.csv),*.csv", _
Title:="EXCELeINFO - guadar hoja activa como archivo nuevo.")
If GuardarComo = False Then
Workbooks(NombreArchivo).Close SaveChanges:=False
Else
With Application.WorksheetFunction
Extension = .Trim(Right(.Substitute(GuardarComo, ".", .Rept(" ", 500)), 500))
End With

Select Case Extension
Case Is = "xlsx"
ActiveWorkbook.SaveAs GuardarComo
Case Is = "xlsm"
ActiveWorkbook.SaveAs GuardarComo, xlOpenXMLWorkbookMacroEnabled
Case Is = "xls"
ActiveWorkbook.SaveAs GuardarComo, xlExcel8
Case Is = "csv"
ActiveWorkbook.SaveAs GuardarComo, xlCSV
Case Else
ActiveWorkbook.SaveAs GuardarComo
End Select
End If
Else
End If
'
End If
'

Exit Sub
'
'En caso de error mostramos un mensaje.
ErrorHandler:
MsgBox "Ha ocurrido un error: " & Err.Description, vbExclamation, "EXCELeINFO"
Workbooks(NombreArchivo).Close SaveChanges:=False
'
End Sub

La macro me guarda la hoja activa del libro y ni bien fue guardada en un libro nuevo este se abre.

Impidiendo que utilice el ActiveWorkbook. Protect ("1q2w3er") dado que el libro activo es el nuevo creado por la macro.