How to copy rows x times based on cell values into another sheet, & create a new column filled with specific content?

Question

I'm very new to VBA and I'm struggling with something I can't manage to succeed.

I have several columns, some of which work in pairs : the first element of the pair represents a size, and the second a corresponding quantity. My goal is to copy into a new sheet as many entire rows as there are in each corresponding quantity, minus the other quantity & size columns - knowing that the value of the "size" columns is not always identical for a given column.

I would like to be able to report the current size onto a specific column on the target sheet (see example below)

As a picture often speaks better than words, I would like it to work as follows:

Here is my code attempt, but it only copies one row at a time (which isn't the most problematic, I can handle to repeat it multiple times), but it doesn't report the size to a unique column in the target sheet:

Public Sub CopyData()
Dim rngSinglecell As Range
Dim rngQuantityCells As Range
Dim intCount As Integer

Set rngQuantityCells = Range("C2", Range("C2").End(xlDown))

For Each rngSinglecell In rngQuantityCells
    If IsNumeric(rngSinglecell.Value) Then
        If rngSinglecell.Value > 0 Then
            For intCount = 1 To rngSinglecell.Value
                Range(rngSinglecell.Address).EntireRow.Copy Destination:=Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Offset(1)
            Next
        End If
    End If
Next
End Sub

I hope my explanation is clear enough. (and sorry for my possible bad English, which isn't my mother language!)

Answer 1

Try that:

Public Sub CopyData()
Dim rngSinglecell As Range
Dim rngQuantityCells As Range
Dim intCount As Integer
Dim ws1 As Worksheet
Dim name_ws As String
Dim lastRow As Long, lastRow2 As Long

name_ws = "Sheet1" '<--- put name of your main worksheet

Set ws1 = ThisWorkbook.Sheets(name_ws)
With ws1

    lastRow = .Cells(Rows.Count, 3).End(xlUp).Row
    Set rngQuantityCells = .Range("C2:C" & lastRow)

    For Each rngSinglecell In rngQuantityCells
        If IsNumeric(rngSinglecell.Value) Then

            If rngSinglecell.Value > 0 Then
                For intCount = 1 To rngSinglecell.Value
                    lastRow2 = ThisWorkbook.Sheets("Feuil2").Cells(Rows.Count, 3).End(xlUp).Row + 1
                    .Rows(rngSinglecell.Row).EntireRow.Copy ThisWorkbook.Sheets("Feuil2").Rows(lastRow2)
                Next
            End If

        End If
    Next

End With

End Sub