Excel - Copy and insert rows n number of times

December 2016




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)) 
'msgbox rng1.Address 
For Each c1 In rng1 

Set dest = Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0) 
'msgbox dest.Address 
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

Related :

This document entitled « Excel - Copy and insert rows n number of times  » from CCM (ccm.net) is made available under the Creative Commons license. You can copy, modify copies of this page, under the conditions stipulated by the license, as this note appears clearly.