Inserting blank rows between cells

This macro can be used to insert blank rows between continuous column values. This was a little tricky to program, but it worked. Like the previous macros, select the first cell and run the macro. Here is the code below.

Sub Insertblankrows()
Dim rowcnt As Long
ActiveSheet.Range(ActiveCell, ActiveCell.End(xlDown)).Select
rowcnt = (Selection.Rows.Count) * 2
For i = 1 To rowcnt
ActiveCell.Cells(2).Select Selection.Rows(i).EntireRow.Insert
Next i
End Sub

Note: If you want to just insert cells (not rows), then change code to "Insert" instead of "Entirerow.Insert" on line 6.