Insert 5 rows between existing values in a single column 1

  • Thread starter Thread starter camsd
  • Start date Start date
C

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.
 
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
 
camsd said:
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.
Click to expand...


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