insert 3 rows between data

[timdavis100]

I need a loop statement to insert 3 rows between each row of data in the
active range. For example:

1
2
3

I need 3 rows inserted between 1 and 2, 3 rows inserted between 2 and 3.
Thanks in advance!

 

[FSt1]

hi
is 1,2,3 your data and is it in column A? if do this would work ....
Sub addrows()
Dim c As Long
Dim r As Range
c = Cells(Rows.Count, "a").End(xlUp).Row
Set r = Range("A2")
For i = 1 To c - 1
r.EntireRow.Insert shift:=xlDown
r.EntireRow.Insert shift:=xlDown
r.EntireRow.Insert shift:=xlDown
Set r = r.Offset(1, 0)
r.Select
Next i
End Sub

if not, post back with more info.

Regards
FSt1

 

[Dave Peterson]

Option Explicit
Sub testme()

Dim wks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim HowManyRows As Long

Set wks = Worksheets("Sheet1")

HowManyRows = 3

With wks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow).Resize(HowManyRows).Insert
Next iRow
End With
End Sub

 

[Dave Peterson]

Ps. I wasn't sure what active range meant, so I looked at column A to find the
last used cell in that column.

Then I used that to determine the range that got the inserted rows.