Solved

# REPEAT ROWS ACCORDING TO CELL VALUE

Posted on 2011-10-18
275 Views
Hi,

Attached is a file that contains a sample table that I obtain from a Pivot Table displaying the parts of the product that I need to print the stickers.

What I need is that each row displayed in the Original table (Rows 3 to 8) must be repeated as many times as the value in column D ("Qty") of each row.

The Quantity of rows will change according the product to produce it's stickers...
I don't care if the result goes in the same Sheet or in a different one.

Please see the attachment showing the original table and the final result that I need.

Roberto.
EE-STICKERS.xls
0
Question by:Pabilio

LVL 24

Accepted Solution

Roberto - try this, results on sheet2:
``````Sub x()

Dim r As Long

With Sheet1
.Range("A3:H3").Copy Sheet2.Range("A1")
For r = 4 To .Range("A" & Rows.Count).End(xlUp).Row
.Cells(r, 1).Resize(, 8).Copy Sheet2.Range("A" & Rows.Count).End(xlUp)(2).Resize(.Cells(r, 4))
Next r
End With

End Sub
``````
0

LVL 39

Assisted Solution

Here's my take on it

``````Sub RepeatLines()
'repeat each line how many times as needed
Dim lLastRow As Long, lRowLoop As Long

application.ScreenUpdating = False
application.Calculation = xlCalculationManual

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

For lRowLoop = lLastRow To 2 Step -1
If Cells(lRowLoop, "D") > 1 Then
Rows(lRowLoop + 1 & ":" & lRowLoop + Cells(lRowLoop, "D") - 1).Insert
Rows(lRowLoop).Copy Rows(lRowLoop + 1 & ":" & lRowLoop + Cells(lRowLoop, "D") - 1)
End If
Next

application.ScreenUpdating = True
application.Calculation = xlCalculationAutomatic

End Sub
``````

Thomas
0

LVL 5

Author Closing Comment

Dear Thomas and Stephen,

Both codes works perfectly.
Thank you very much for your time.

Cheers,
Roberto.
0