Duplicate each row different number of times

artizhay

New Member
Joined
Jul 22, 2010
Messages
8
Hello! What I'm looking to do is duplicate each row a different number of times (either in the same sheet or a new sheet) so that there end up being x # of instances of each row as defined by column C.

Example:
Excel Workbook
ABC
1Item #ItemCopy
2PRO-CEL-00-BLK2000-2003 Toyota Celica4
3PRO-CEL-03-BLK2003-2005 Toyota Celica3
Beginning


Excel Workbook
ABC
1Item #ItemCopy
2PRO-CEL-00-BLK2000-2003 Toyota Celica4
3PRO-CEL-00-BLK2000-2003 Toyota Celica4
4PRO-CEL-00-BLK2000-2003 Toyota Celica4
5PRO-CEL-00-BLK2000-2003 Toyota Celica4
6PRO-CEL-03-BLK2003-2005 Toyota Celica3
7PRO-CEL-03-BLK2003-2005 Toyota Celica3
8PRO-CEL-03-BLK2003-2005 Toyota Celica3
Result


I have looked up duplication macros and found some that work well, but they duplicated by a set number of times and I need to duplicate various times per row.

Thanks a ton!
 

Some videos you may like

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,059
Office Version
365, 2010
Platform
Windows
Try this. The 'copies' will go into a new sheet added immediately after the sheet with the original data which I have assumed is 'Sheet1'. Change to match your sheet name.
Code:
Sub MakeCopies()
Dim sRng As Range, sSht As Worksheet, rRng As Range, rSht As Worksheet
Dim sRw As Long, rRw As Long, i As Long, ctr As Long

Set sSht = Sheets("sheet1") 'Enter your sheet name between the quotes
With sSht
    sRw = .Cells(Rows.Count, 1).End(xlUp).Row
End With
Set rSht = Sheets.Add(after:=sSht)
With rSht
    .Range(Cells(1, 1), Cells(1, 3)) = Array("Item #", "Item", "Copy")
End With
For i = 1 To sRw - 1
    ctr = 0
    Do Until ctr >= sSht.Cells(i + 1, 3).Value
        rRw = rSht.Cells(Rows.Count, 1).End(xlUp).Row
        sSht.Activate
        With sSht
         .Range(Cells(i + 1, 1), Cells(i + 1, 2)).Copy Destination:=rSht.Cells(rRw + 1, 1)
        End With
        ctr = ctr + 1
    Loop
Next i

End Sub
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
45,918
Office Version
365
Platform
Windows
You could try this in a copy of your workbook.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> InsertRows()<br>    <SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, newrows <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    lr = Range("C" & Rows.Count).End(xlUp).Row<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">For</SPAN> r = lr <SPAN style="color:#00007F">To</SPAN> 2 <SPAN style="color:#00007F">Step</SPAN> -1<br>        newrows = Range("C" & r).Value - 1<br>        <SPAN style="color:#00007F">If</SPAN> newrows > 0 <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#00007F">With</SPAN> Range("A" & r).Resize(, 3)<br>                .Copy<br>                .Offset(1).Resize(newrows).Insert Shift:=xlDown<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> r<br>    Application.CutCopyMode = <SPAN style="color:#00007F">False</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>
 

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,106,001
Messages
5,508,718
Members
408,690
Latest member
Lip Renan

This Week's Hot Topics

  • Turn fraction around
    Hello I need to turn a fraction around, for example I have 1/3 but I need to present as 3/1
  • TIme Clock record reformatting to ???
    Hello All, I'd like some help formatting this (Tbl-A)(Loaded via Power Query) [ATTACH type="full" width="511px" alt="PQdata.png"]22252[/ATTACH]...
  • TextBox Match
    hi, I am having a few issues with my code below, what I need it to do is when they enter a value in textbox8 (QTY) either 1,2 or 3 the 3 textboxes...
  • Using Large function based on Multiple Criteria
    Hello, I can't seem to get a Large formula to work based on two criteria's. I can easily get a oldest value based one value, but I'm struggling...
  • Can you check my code please
    Hi, Im going round in circles with a Compil Error End With Without With Here is the code [CODE=rich] Private Sub...
  • Combining 2 pivot tables into 1 chart
    Hello everyone, My question sounds simple but I do not know the answer. I have 2 pivot tables and 2 charts that go with this. However I want to...
Top