Insert new row between rows

[triaji]

Dear forum,
How create macro for insert row in every data?
please find the attachment for more details.
Thank you very much

[TMS]

One way, try:

Option Explicit
Sub InsertRows()
Dim lLRow As Long
Dim lLC As Long
lLRow = Range("A2").End(xlDown).Row
For lLC = lLRow To 4 Step -1
    Range("A" & lLC).EntireRow.Insert shift:=xlDown
Next 'lLC
End Sub

Regards

[watersev]

Sub Insr()
Dim i As Long: Application.ScreenUpdating = False
For i = [a3].End(xlDown).Row To 4 Step -1
      If Cells(i, 1) <> "" Then Cells(i, 1).EntireRow.Insert shift:=xlDown:
Next: End Sub

or check attached file, run macro "Insr"

[triaji]

Thank you very much... you both are great,master