This code takes 5 seconds to run. Any suggestions on how to get that down to 3?

[VBE313]

Dim rngstart As Range
 Dim l As Long, strCells As String
        ActiveSheet.Unprotect Password:="B28"
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.Calculation = xlCalculationManual
        pagebreakstate = ActiveSheet.DisplayPageBreaks
        ActiveSheet.DisplayPageBreaks = False
  Set rngstart = ActiveCell
        l = ActiveCell.Row
        strCells = "F" & l
        Range(strCells).Select
        Rows(ActiveCell.Row).Select
        Rows(ActiveCell.Row).Offset(1, 0).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        ActiveCell.RowHeight = 13.5
        Rows(ActiveCell.Row).Offset(1, 0).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Selection.Offset(-1, 0).Select
        ActiveCell.RowHeight = 5
        Rows(ActiveCell.Row).Interior.ColorIndex = 0
        Rows(ActiveCell.Row).Locked = True
        ActiveCell.Offset(-1, 0).Select
        Rows(ActiveCell.Row).Select
        Selection.Copy
        ActiveCell.Offset(2, 0).Select
        ActiveSheet.paste
        Rows(ActiveCell.Row).Select
        Range(strCells).Select
        ActiveCell.Offset(2, 0).Select
        Rows(ActiveCell.Row).ClearContents
        ActiveCell.Interior.ColorIndex = 8
        ActiveCell.Offset(0, -2).Interior.ColorIndex = 8
        ActiveCell.Offset(0, -4).Interior.ColorIndex = 8
          ActiveSheet.Protect Password:="B28"
         ActiveSheet.Protect AllowFormattingColumns:=True
         Application.ScreenUpdating = True
         Application.EnableEvents = True
         Application.Calculation = xlCalculationAutomatic
         ActiveSheet.DisplayPageBreaks = pagebreakstate