VBA Copy from Dynamic Range - Paste to another Sheet

[lemanstom]

Hi
Relative noob, new to the forum at least, so please excuse my ignorance. I have a workbook with multiple sheets, 2 of which I need to copy data from and to (only one way).

Basically the source sheet contains a dynamic list of 'Products' in Column A, a Quantity of said product in Column B, then Column C contains another Quantity. I'm trying to loop down through Column C to find any cells with a quantity in, then copy that value over to the Destination sheet Column G, starting in cell G6. Then I need it to copy and paste the relevant 'Product' name from the row in Source Column A to Destination Column A (same row as the quantity that's been copied). Currently have it all triggered by a commandbutton for testing...

Using the following code I've been successful in copying the first product found, but it seems to stop after this, it doesn't iterate/loop down through the column until no further quantities are found.

I hope I've explained that in enough detail, and it makes some sense!

Any help any of you clever people can provide will be gratefully received. I've spent so much time reading through other threads on multiple forums with no joy. I'm betting it's a simple fix, but I'm blind to what it might be
Here's the code I've been using:

Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False
      
    Dim shSource As Worksheet, shDest As Worksheet, sourceRng As Range, sourceCell As Range, lr As Long
    Dim i As Integer
    ' Set Source Sheet
    Set shSource = Me.Parent.Worksheets("SourceSheet")
    'Set Destination Sheet
    Set shDest = Me.Parent.Worksheets("DestinationSheet")
    'Find Last Row on Source Sheet
    lr = shSource.Cells(Rows.Count, 1).End(xlUp).Row
    'Set Source Sheet Range
    Set sourceRng = shSource.Range("C2:C" & lr)
    'Find Next Empty Cell of Column G on Destination Sheet
    nextFreeCell = shDest.Range("G6:G" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
    
    'Loop to copy data from Source to Destination
    For Each sourceCell In sourceRng
        If sourceCell.Value > 0 Then
            shDest.Range("G" & nextFreeCell).Value = sourceCell.Value
            shDest.Range("A" & nextFreeCell).Value = sourceCell.Offset(, -2).Value
        End If
    Next sourceCell
           
    Application.ScreenUpdating = True
    
End Sub

 

[lemanstom]

Sorry, probably would help to have a simple screenshot of the idea...

 

[Fluff]

You need to increment next row inside the loop, otherwise it will continually overwrite the same cell

        If sourceCell.Value > 0 Then
            shDest.Range("G" & nextFreeCell).Value = sourceCell.Value
            shDest.Range("A" & nextFreeCell).Value = sourceCell.Offset(, -2).Value
            nextFreeCell = nextFreeCell + 1
        End If

 

[lemanstom]

You need to increment next row inside the loop, otherwise it will continually overwrite the same cell

        If sourceCell.Value > 0 Then
            shDest.Range("G" & nextFreeCell).Value = sourceCell.Value
            shDest.Range("A" & nextFreeCell).Value = sourceCell.Offset(, -2).Value
            nextFreeCell = nextFreeCell + 1
        End If

Fluff! Well as far as first experiences go, this was amazing! Thank you so much, I'm very grateful, I knew it was going to be a simple one-liner but my brain was fried.

Appreciate that, it works perfectly now

 

[Fluff]

Glad to help & thanks for the feedback.