Option Explicit

Sub InsertBlankRows()
Dim lr As Long, r As Long

On Error Resume Next

Application.ScreenUpdating = False

    For r = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -100
        If Range("A" & r) <> "" And Range("A" & r - 100) <> "" Then Rows(r).Insert (1)
    Next r
    
Application.ScreenUpdating = True

End Sub