Macro to break quantiy for 1,2,3 etc to single lines

[tonywatsonhelp]

Hi everyone,
but of a problem,

I've asked my supplier for product codes and they sent me a list in excel

its in sheet"data1"
Row 1 is headers
the data is in columns A:BZ
now the problem i have is some products are sold in Quantiys and some are not,

Column G has the quanity in it. for singlr items this is blank so the row is fine
But for multipacks i get this in column G "1,2,3,4,5,6" or "12,24,35" it can be any number seperated by a comma everytime.

I need amacro to copy the data from sheet Data1 to sheet Data2
if the row has nothing in column G then just copy it once, if it has data then i need it split up into multiple rows so each row only has 1 of the numbers.

Please help if you can

Thanks

Tony

 

[mumps]

Try:

Sub CopyRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long, qty As Range, splitQty As Variant, i As Long, srcWS As Worksheet, desWS As Worksheet
    Set srcWS = Sheets("Data1")
    Set desWS = Sheets("Data2")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each qty In srcWS.Range("G2:G" & LastRow)
        If qty = "" Then
            qty.EntireRow.Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
        Else
            splitQty = Split(qty, ",")
            For i = LBound(splitQty) To UBound(splitQty)
                srcWS.Rows(qty.Row).EntireRow.Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
                desWS.Range("G" & desWS.Range("G" & desWS.Rows.Count).End(xlUp).Row) = splitQty(i)
            Next i
        End If
    Next qty
    Application.ScreenUpdating = True
End Sub

 

[tonywatsonhelp]

Thanks again mumps,
you are a saviour!
Tony

 

[mumps]

You're welcome.