Macro to protect workbook not working

Hello,

I need protected workbook but I still need to add sheets into it. What I've tried so far, is that I protect workbook (you can't add sheet if workbook is protected), then I put these two lines into code.

This one in the beginning
ActiveWorkbook.Unprotect

and this one at the end
ActiveWorkbook.Protect


Problem is everytime I run the code, protection goes off (?). What do I need to do that protection stays on when I add more sheets??

This one's the code that adds sheet;

Sub UusiSivu()
ActiveWorkbook.Unprotect
Dim CurrentDay As Integer
Dim NewName As String
Dim WS As Worksheet
Set WS = ActiveSheet
If IsNumeric(Right(WS.Name, 2)) Then
   CurrentDay = Right(WS.Name, 2)
ElseIf IsNumeric(Right(WS.Name, 1)) Then
   CurrentDay = Right(WS.Name, 1)
Else
   Exit Sub
End If

CurrentDay = CurrentDay + 1
NewName = Format(Date, "dd.mm.yyyy")
Dim checkWs As Worksheet
On Error Resume Next
Set checkWs = Worksheets(NewName)
If checkWs Is Nothing Then
'Copies the current sheet to the end of the workbook
    Sheets("Default").Copy after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = NewName
  Dim oleObj As OLEObject
Else
   Set checkWs = Nothing
   MsgBox "Uusi taulukko voidaan lisätä huomenna."
ActiveWorkbook.Protect
End If
End Sub