This seemed to work ok.

Option Explicit
Sub testme()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim oRow As Long
Dim HowMany As Long

Set CurWks = Worksheets("Sheet1")
Set NewWks = Worksheets.Add

With CurWks
'move numbers to column A
.Range("B1").EntireColumn.Cut
.Range("A1").EntireColumn.Insert

FirstRow = 1 'no headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

oRow = 1
For iRow = FirstRow To LastRow
HowMany = .Cells(iRow, "A").Value
.Cells(iRow, "B").Resize(1, 3).Copy
NewWks.Cells(oRow, "A").Resize(HowMany, 3).PasteSpecial _
Paste:=xlPasteValues
oRow = oRow + HowMany
Next iRow

'Put 'em back
.Range("a1").EntireColumn.Cut
.Range("c1").EntireColumn.Insert

End With

End Sub


wrote:

I can't figure out to program this, please help!

I have rows of data like this:
Name | Quantity | Attribute 1 | Attribute 2
EX1 | 2 | att1 | att2
EX2 | 3 | att1 | att2
EX3 | 2 | att1 | att2

I want it to expand the quantities into rows to look like this:
Name | attribute 1 | attribute 2 | etc
EX1 | att1 | att2
EX1 | att1 | att2
EX2 | att1 | att2
EX2 | att1 | att2
EX2 | att1 | att2
EX3 | att1 | att2
EX3 | att1 | att2

The Attribute 1 column and Attribute 2 column are just columns that
hold data that needs to be copied to each row.

This is to make a mail merge with multiple labels with the same
information!

--

Dave Peterson