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