[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
• Status: Solved
• Priority: Medium
• Security: Public
• Views: 328

REPEAT ROWS ACCORDING TO CELL VALUE

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
Pabilio
2 Solutions

Commented:
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

Commented:
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

Author Commented:
Dear Thomas and Stephen,

Both codes works perfectly.