Help Duplicating Rows

mountainkids

New Member
Joined
Jul 24, 2021
Messages
6
Platform
  1. Windows
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.

1627137431643.png
 

Attachments

  • 1627137353283.png
    1627137353283.png
    63.2 KB · Views: 3

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,628
Try this macro. Change the sheet names (in red) to suit your needs.
Rich (BB code):
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

New Member
Joined
Jul 24, 2021
Messages
6
Platform
  1. Windows
I tried and keep getting this error. I must be doing something wrong.
1627146370289.png



Try this macro. Change the sheet names (in red) to suit your needs.
Rich (BB code):
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

Well-known Member
Joined
Apr 11, 2012
Messages
10,628
Make sure that when you copied/pasted the macro you included the very last line:
VBA Code:
End Sub
 

mountainkids

New Member
Joined
Jul 24, 2021
Messages
6
Platform
  1. Windows

ADVERTISEMENT

Type mismatch error?
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,628
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

New Member
Joined
Jul 24, 2021
Messages
6
Platform
  1. Windows

ADVERTISEMENT

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.

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

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,628
Try:
VBA Code:
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

New Member
Joined
Jul 24, 2021
Messages
6
Platform
  1. Windows
Awesome! Thank you 100x over!


Try:
VBA Code:
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
 

Forum statistics

Threads
1,144,528
Messages
5,724,859
Members
422,586
Latest member
nassardewa

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top