Add Blank Rows After Each Row in the Active Sheet

!....Excel VBA program to Add Blank Rows after Each Row in the Activesheet...!

Sub add_blankrow()

Application.ScreenUpdating = False
For i = 1 To Range("a1").End(xlDown).Row
ActiveCell.Offset(1, 0).Select
Rows(ActiveCell.Row).Insert
ActiveCell.Offset(1, 0).Select
Next

End Sub