VBE313
04-04-2019, 08:42 AM
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
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