Insert 5 rows between existing values in a single column 1

[camsd]

I have a sheet with over 10,000 rows of existing data, all in a single column.

I need to insert 5 rows in between each existing row quickly and easily.
Doing it manually is not so efficient!

For example:

F14745
F14746
F14747

needs to become:

F14745




F14746




F14747



etc.,

Likey a way to do this with a Macro, but I don't have a clue on how to do it.
Easy way seems to elude me.

Thanks.

 

[Otto Moehrbach]

Run this macro. I assumed the data is in Column A starting in A2 with row 1
being headers. HTH Otto
Sub Insert5Rows()
Dim rColA As Range
Dim c As Long
Set rColA = Range("A2", Range("A" & Rows.Count).End(xlUp))
c = rColA(rColA.Count).Row
Application.ScreenUpdating = False
Do
Cells(c, 1).Rows("1:5").EntireRow.Insert Shift:=xlDown
c = c - 1
Loop Until c = 2
Application.ScreenUpdating = True
End Sub

 

[Glenn]

I have a sheet with over 10,000 rows of existing data, all in a single column.

I need to insert 5 rows in between each existing row quickly and easily.
Doing it manually is not so efficient!

For example:

F14745
F14746
F14747

needs to become:

F14745




F14746




F14747



etc.,

Likey a way to do this with a Macro, but I don't have a clue on how to do it.
Easy way seems to elude me.

Thanks.

I assume your data is in column A. Create a new sheet. In A1, put the following:

=IF(MOD(ROW()-1,6)=0,INDIRECT("YourSheet!A"&(ROW()-1)/6+1),"")

Replace "YourSheet" as necessary. Fill down. Copy, Paste Special (values).

 

[ShaneDevenshire]

Hi,

Assume your data starts in cell A1 then the following macro will do what you
want

Sub Insert5Rows()
Dim myBot As Long
Dim I As Integer
myBot = [A65000].End(xlUp).Row
Range([B1], Range("B" & myBot)) = "=1/MOD(ROW(RC[-1]),2)"
Selection.SpecialCells(xlCellTypeFormulas, 16).EntireRow.Insert
myBot = [A65000].End(xlUp).Row
Range([B1], Range("B" & myBot)) =
"=1/IF(AND(RC[-1]<>"""",R[1]C[-1]=""""),1,0)"
Selection.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Insert
Columns("B:B").ClearContents
For I = 1 To 4
Columns("A:A").SpecialCells(xlCellTypeConstants, 23).Select
Selection.EntireRow.Insert
Next I
End Sub

 

[Rick Rothstein]

I'm not sure, but I think this may be more efficient than using code to
insert the rows directly...

Sub Add5RowsBetweenEachExistingRow()
Dim X As Long
Dim LastRow As Long
Const StartRow As Long = 2
Const AddRows As Long = 5
On Error GoTo Whoops
Application.ScreenUpdating = False
With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For X = LastRow To StartRow Step -1
.Rows(X).Copy .Cells((AddRows + 2) * (X - StartRow) + StartRow, "A")
If X > StartRow Then .Rows(X).Delete
Next
End With
Whoops:
Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

This slight modification is probably a little better coding-wise...

Sub Add5RowsBetweenEachExistingRow()
Dim X As Long
Dim LastRow As Long
Const StartRow As Long = 2
Const AddRows As Long = 5
On Error GoTo Whoops
Application.ScreenUpdating = False
With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For X = LastRow To StartRow + 1 Step -1
.Rows(X).Copy .Cells((AddRows + 2) * (X - StartRow) + StartRow, "A")
.Rows(X).Delete
Next
End With
Whoops:
Application.ScreenUpdating = True
End Sub

 

[Ashish Mathur]

Hi,

If you are looking for a non macro solution, try this:

1. In a spare column (say B), enter numbers from 1-10,000. In B10001, enter
1 again and copy down till B20001
2. Perform step 1 4 more times
3. Now assign a heading to column B;
4. Sort column B in ascending order;
5. you will notice that 5 rows will be inserted between all values

--
Regards,

Ashsih Mathur
Microsoft Excel MVP
www.ashishmathur.com

 

[RagDyer]

You say you want to insert 5 rows between each existing row,
*however*, your example displays only 4 rows.

Here's an approach you might like to try,
where your data displays in every *5th* row, which means 4 rows in between,
as in your example.

Say you enter this formula along side your existing data, in G14745:
(although it can be entered *anywhere*)

=INDEX(F:F,14744+ROWS($1:5)/5)

Then, select G14745 to G14749,
That's one cell with the formula, and 4 empty cells.

Now, click on the fill handle of that 5 cell selection,
and drag down as needed.

You can then <Copy> and <Paste Special> <Values>,
to remove the formulas, and leave just the data behind.

If desired, you could then delete the original data.