Help Duplicating Rows

[mountainkids]

Hi!

I need to create a sheet that would duplicate the values in A, C and I based on the number in N. I will use this to create product label in Word using mail merge, the number in N is the qty I need. Based on my research, I know I need to use macros but that is far outside my ability. I basically need one thats totally written or steps on how to modify.

So ideally, when I run the macro, it will create a new sheet and rows 1-4 will be the first product sku, description and price repeated. Row 5-10 will be product 2 repeated 5x and so on. Thanks in advance to anyone able to help! This is so outside my ability but I feel like doing it manually will be too time consuming as its hundreds of items.

 

[mumps]

Try this macro. Change the sheet names (in red) to suit your needs.

Sub CreateSheet()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, rng As Range, x As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In srcWS.Range("N1:N" & LastRow)
        With desWS
            For x = 1 To rng.Value
                Intersect(Rows(rng.Row), Range("A:A,C:C,I:I")).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
            Next x
        End With
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[mountainkids]

I tried and keep getting this error. I must be doing something wrong.

Try this macro. Change the sheet names (in red) to suit your needs.

Sub CreateSheet()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, rng As Range, x As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In srcWS.Range("N1:N" & LastRow)
        With desWS
            For x = 1 To rng.Value
                Intersect(Rows(rng.Row), Range("A:A,C:C,I:I")).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
            Next x
        End With
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[mumps]

Make sure that when you copied/pasted the macro you included the very last line:

End Sub

 

[mountainkids]

Type mismatch error?

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

 

[mountainkids]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

Dropbox - File Deleted - Simplify your life

www.dropbox.com

Oh that would be much easier. Thank you for your help!!!

 

[mountainkids]

Actually I think this link you can edit. CatalogLabelVersion.xlsx

 

[mumps]

Try:

Sub CreateSheet()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, rng As Range, x As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In srcWS.Range("N2:N" & LastRow)
        If rng <> "OutOfStock" Then
            With desWS
                For x = 1 To rng.Value
                    Intersect(Rows(rng.Row), Range("A:A,C:C,I:I")).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                Next x
            End With
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[mountainkids]

Awesome! Thank you 100x over!

Try:

Sub CreateSheet()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, rng As Range, x As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In srcWS.Range("N2:N" & LastRow)
        If rng <> "OutOfStock" Then
            With desWS
                For x = 1 To rng.Value
                    Intersect(Rows(rng.Row), Range("A:A,C:C,I:I")).Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                Next x
            End With
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub