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

Question

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.

what is r ? and where did you define ans Set it ? is it suppose to be a Range ? — Shai Rado
I'm really new at this. This is the code I copied from the link mentioned above. I'm not sure what it's supposed to mean. — cheng
You copied a little bit from one answer and another section from the other answer. What is the value in column "H" you are looking for in ordet to copy it to "Sheet"1 — Shai Rado
You want to copy data from sheet1 to sheet2 whenever the value in H column is greater than one. Right ? — Digvijay
Greater than zero. If the value is 0, the row will not be copied into sheet2 If the value in H is 1, the row of data is copied into sheet2 once. If the value in H is 2, the row of data is copied twice into sheet2. — cheng

court_k court_k · Accepted Answer · 2018-08-10T13:50:32

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! :)

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

1 Answers