# Excel - Copy and insert rows n number of times

October 2017

## Issue

I have a sheet with over 800 rows. I need to copy each row and insert/repeat each entry 4 times below the preceding row.

Example:

Before

name1
name2
name3

After

name1
name1
name1
name1
name2
name2
name2
name2
name3
name3
name3
name3

## Solution

This type of macro can help:

Sub test()

```Dim rng As Range, c As Range
Dim rng1 As Range, c1 As Range
Dim dest As Range, j As Integer, k As Integer
Worksheets("sheet2").Cells.Clear
With Worksheets("sheet1")
Set rng = Range(.Range("A2"), .Range("A2").End(xlDown))
j = WorksheetFunction.CountA(.Rows("1:1"))
'msgbox j
For Each c In rng
Set rng1 = Range(c.Offset(0, 1), .Cells(c.Row, Columns.Count).End(xlToLeft))
For Each c1 In rng1

Set dest = Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
If c1 = "" Then GoTo line1
'dest.Offset(0, 0) = c
'dest.Offset(0, 1) = .Cells(1, c1.Column)
'dest.Offset(0, 2) = c1
dest = c
dest.Offset(0, 1) = c1
dest.Offset(0, 2) = .Cells(1, c1.Column)
line1:
Next c1

Next c
End With
With Worksheets("sheet2").Columns("c:c")
.NumberFormat = "dd-mmm-yy"
End With
End Sub```
Published by aakai1056. Latest update on March 1, 2012 at 10:36 AM by aakai1056.