Copy rows x number of times into a new sheet

I have an inventory worksheet that has details about different products, such as product code, description, price, quantity.
I need to copy these cells into a new spreadsheet such that each row is copied x number of times - based on the number in the quantity column.
I need this in order to import this new sheet into a word mail merge for the purpose of printing some barcodes.

i.e.

Product	Description	Price	Quantity
0001	Table	$50	2
0002	Vase	$20	2
0003	Painting	$60	1
0004	Tray	$30	3

I need to copy this data into a new spreadsheet such that:

Product	Description	Price	Quantity
0001	Table	$50	2
0001	Table	$50	2
0002	Vase	$20	4
0002	Vase	$20	4
0002	Vase	$20	4
0002	Vase	$20	4
0002	Vase	$20	4
0003	Painting	$60	1
0004	Tray	$30	3
0004	Tray	$30	3
0004	Tray	$30	3

Please assist me with with an appropriate macro that will enable me to achieve this.
Thank you.

How did you get 6 Vase while the quantity shows 2?

Assuming it was 2 vase.

Maybe:

Please Login or Register  to view this content.

I used Sheet2 as the new sheet. If you want the macro to create a new sheet the let me know.

Sorry vase quantity was meant to be 5.

The macro is only copying the column titles, i.e row 1.

No, it copies all rows. Please look at the attached sheet2.

Thank you for your quick reply. I tried to copy the macro sub into my spreadsheet and it was only copying the column titles. I will move my data to your spreadsheet instead. Thanks again.

Is the code now working or not? If not, please attach the sample you are working on.

It working.

What change do I need to make if I wish to have 6 columns copying instead of just 4?

Expand the array line to 6

Please Login or Register  to view this content.

That's giving me a "runtime error '9': script out of range.

Oops!

Please Login or Register  to view this content.

I'm still getting the same error.

The quantity is still in column D. I have just added information in E & F.

Please show me where you are getting an error.

Here's a print screen...

Ok, I decided to move quantity to the final column & changed the macro as follows:

Sub Repeat_x()

Dim x, i As Long, NR As Long, LR&

With Sheets("Sheet1")
LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
x = .Range("A1:F" & LR)
End With
NR = 2
Application.ScreenUpdating = False
With Sheets("Sheet2")
For i = 2 To UBound(x, 1)
If (x(i, 6)) > 0 Or IsError(x(i, 6)) Then
.Cells(NR, "A").Resize(CLng(x(i, 6)), 6) = Array(x(i, 1), x(i, 2), x(i, 3), x(i, 4), x(i, 5), x(I, 6))
NR = NR + x(i, 6)
End If
Next i
Application.ScreenUpdating = True
End With
End Sub


This appears to be working.

Thank you so much for your assistance. God bless you

This macro was working perfect, with no issues. However, today, suddenly the macro has stopped running. I am not getting any errors, just the macro is not running. Can someone please help me? I've tried to look through the spreadsheet, but cannot find a reason for this.

Jeni,
Please use code tags with your code as per forum's rule.
The issue can easily be solved if you could attach the code with the sample you are working on.