CODEWITHSUNDEEP
vbaexcel
cheng
cheng

Reputation: 1

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.

Upvotes: 0

Views: 2520

Answers (1)

court_k
court_k

Reputation: 101

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

Upvotes: 1

Related Questions