Create multiple copies of rows based on a cell value

[Guest]

I'm trying to create an input file for a mail merge that will create multiple
copies of rows based on a cell value. For example my sheet1 has:
name address qty
henry 123 anystreet 5

I need a sheet2 that contains 5, (the qty), rows of the name and address.
Each record may have a different qty.

Hope I have explained this well enough.

TIA,
Henry

 

[Guest]

Henryl,

Try this:

Option Explicit
Sub temp()
Dim LastRow As Long
Dim Qty As Integer
Dim i As Long
Dim j As Long
Dim k As Long

j = 2
LastRow = Sheets("Sheet1").Cells(65536, 1).End(xlUp).Row
For i = 2 To LastRow
With Sheets("Sheet1")
Qty = Cells(i, 3)
.Range(Cells(i, 1), Cells(i, 2)).Copy
End With
With Sheets("Sheet2")
For k = j To j + Qty - 1
.Range(.Cells(k, 1), .Cells(k, 2)).PasteSpecial
Next k
End With
j = j + Qty
Next i
End Sub

Art

 

[Bob Phillips]

Sub Test()
Dim iLastRow As Long
Dim iRow As Long
Dim i As Long

iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
iRow = 1
For i = 1 To iLastRow
Range("A" & i & ":B" & i).Copy Worksheets("Sheet2") _
.Range("A" & iRow & ":B" & iRow + Range("C" & i).Value - 1)
iRow = iRow + Range("C" & i).Value
Next i

End Sub



--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)