Clash Royale CLAN TAG#URR8PPP

duplicate row “x” number of times based on cell value

I'm trying to duplicate rows in sheet 1 based on the value indicated in column H of sheet 1, onto sheet 2.

I found a code that seems to work, but it changes the data in the original worksheet, instead of copying the rows into a different worksheet, say "Sheet2".

Sub CopyData()
'Updateby Extendoffice 20160922
Dim xRow As Long
Dim VInSertNum As Variant
xRow = 1
Application.ScreenUpdating = False
Do While (Cells(xRow, "A") <> "")
VInSertNum = Cells(xRow, "H")
If ((VInSertNum > 1) And IsNumeric(VInSertNum)) Then
Range(Cells(xRow, "A"), Cells(xRow, "H")).Copy
Range(Cells(xRow + 1, "A"), Cells(xRow + VInSertNum - 1, "H")).Select
Selection.Insert Shift:=xlDown
xRow = xRow + VInSertNum - 1
End If
xRow = xRow + 1
Loop
Application.ScreenUpdating = False
End Sub

How do I change this code such that it runs the macro in the original extract worksheet "Sheet1" and copies the rows into "Sheet2", if the value in column H is more than 0?

Sample data in Sheet1 would be as below. The value in container is in column H, which determines the number of rows to be copied & duplicated into Sheet2.

Supplier Dest Code Quantity Container
A US01 10001 1000 2
A US02 10002 500 4
B UK01 10001 0 0
C US01 10004 1300 1


The desired result in Sheet2 is as below:

Supplier Dest Code Quantity Container
A US01 10001 1000 2
A US01 10001 1000 2
A US02 10002 500 4
A US02 10002 500 4
A US02 10002 500 4
A US02 10002 500 4
C US01 10004 1300 1


Thank you.

r

Set

Range

1 Answer
1

I know this question is old but it didn't have an answer so I thought it would be okay to submit one.

I made a new macro I thought would be simpler, easier to read and thus understand. All these things that would make it easier for you to edit if you required changes later.

From my understanding, you have information in column D to column H that you want to duplicate x amount of times; where x is a value in column H. I assumed your sheets were named "Sheet1" and "Sheet2". I have provided an answer below.

Dim wsc As Worksheet 'worksheet copy
Dim wsd As Worksheet 'worksheet destination

Dim lrow As Long 'last row of worksheet copy
Dim crow As Long 'copy row
Dim drow As Long 'destination row

Dim multiplier As Integer
Dim i As Integer 'counting variable for the multiplier

Set wsc = Sheets("Sheet1")
Set wsd = Sheets("Sheet2")

lrow = wsc.Range("h" & wsc.Rows.Count).End(xlUp).row
drow = 2

With wsc

For crow = 2 To lrow 'starts at 2 because of the header row

multiplier = .Cells(crow, 8).Value 'copies the value in column h

For i = 1 To multiplier

wsd.Cells(drow, 4).Value = .Cells(crow, 4).Value
wsd.Cells(drow, 5).Value = .Cells(crow, 5).Value
wsd.Cells(drow, 6).Value = .Cells(crow, 6).Value
wsd.Cells(drow, 7).Value = .Cells(crow, 7).Value
wsd.Cells(drow, 8).Value = .Cells(crow, 8).Value

drow = drow + 1 'increasing the row in worksheet destination

Next i

Next crow

End With


If there are any ways in which this answer could be improved please let me know! :)

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.