Sub MyFillMacro()
Dim i As Integer
Dim lr As Long
Dim r As Long
Dim v As Variant
Dim x As Long
Application.ScreenUpdating = False
i = InputBox("What interval do you want?")
If i <= 1 Then
MsgBox "You have entered an invalid value", vbOKOnly, "ENTRY ERROR!"
Exit Sub
End If
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 1 Step -1
v = Cells(r, "A")
x = i - Application.WorksheetFunction.CountIf(Range("A:A"), v)
If x > 0 Then
Rows(r + 1 & ":" & r + x).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range(Cells(r + 1, "A"), Cells(r + x, "A")) = v
End If
Next r
Application.ScreenUpdating = True
End Sub