Excel - Copy and insert rows n number of times

January 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)) 
'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


Published by aakai1056. Latest update on March 1, 2012 at 10:36 AM by aakai1056.
This document, titled "Excel - Copy and insert rows n number of times ," is available under the Creative Commons license. Any copy, reuse, or modification of the content should be sufficiently credited to CCM (ccm.net).