Macro: inserting 3 blank rows and also add a row with formula in the middle row

[isaactanyh]

Hi,

Can anyone help me with this? Your help is much appreciated.

I currently have a table of data where i need to enter 3 rows in after the value changes and is using the vba below.

Sub InsertRowsAtValueChange()
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
For i = WorkRng.Rows.Count To 2 Step -1
If WorkRng.Cells(i, 1).Value <> WorkRng.Cells(i - 1, 1).Value Then
Range(WorkRng.Cells(i, 1).EntireRow, WorkRng.Cells(i + 3, 1).EntireRow).Insert
End If
Next
Application.ScreenUpdating = True
End Sub

I am also looking to add a row with formula to help me decide which info to keep. I have already figured the formula, but is now struggling to automate the copy+paste process after inserting the 3 blank rows.

Row 5, the middle row of the three newly inserted blank rows will have the formula.

This is the sheet where the formula will be copied from.
Let me know if you need other information! Thanks a lot!