insert 3 rows between data

  • Thread starter Thread starter timdavis100
  • Start date Start date
T

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!
 
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
 
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
 
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.
 
Back
Top