Protected Worksheet can't Insert Line

Sub InsertRow()
  '-- this macro shows on Tools, Macro..., Macros (Alt+F8) dialog
  Call InsertRowsAndFillFormulas
End Sub
 
Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)
ActiveSheet.Unprotect
   Dim x As Long
   ActiveCell.EntireRow.Select  'So you do not have to preselect entire row
   If vRows = 0 Then
    vRows = Application.InputBox(prompt:= _
      "How many rows do you want to add?", Title:="Add Rows", _
      Default:=1, Type:=1) 'Default for 1 row, type 1 is number
    If vRows = False Then Exit Sub
   End If
   'if you just want to add cells and not entire rows
   'then delete ".EntireRow" in the following line
      Dim sht As Worksheet, shts() As String, i As Long
   ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
       Windows(1).SelectedSheets.Count)
   i = 0
   For Each sht In _
       Application.ActiveWorkbook.Windows(1).SelectedSheets
    Sheets(sht.Name).Select
    i = i + 1
    shts(i) = sht.Name
    x = Sheets(sht.Name).UsedRange.Rows.Count
ActiveSheet.Unprotect
    Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
     Resize(rowsize:=vRows).Insert Shift:=xlDown
    Selection.AutoFill Selection.Resize( _
     rowsize:=vRows + 1), xlFillDefault
    On Error Resume Next
    Selection.Offset(1).Resize(vRows).EntireRow. _
     SpecialCells(xlConstants).ClearContents
   Next sht
   Worksheets(shts).Select
   ActiveSheet.Protect
End Sub

ActiveSheet.Unprotect Password:="yourpassword"
ActiveSheet.Protect Password:="yourpassword"