如何根據單元格值將行 x 次復制到另一個工作表中，並創建一個填充特定內容的新列？

Question

我對 VBA 很陌生，我正在努力解決我無法成功的事情。

我有幾列，其中一些成對工作：該對的第一個元素表示大小，第二個元素表示相應的數量。 我的目標是將每個相應數量的整行復制到新工作表中，減去其他數量和大小列 - 知道給定列的“大小”列的值並不總是相同。 我希望能夠將當前大小報告到目標工作表上的特定列（參見下面的示例）

由於圖片往往勝過文字，我希望它可以如下工作：

這是我的代碼嘗試，但它一次只復制一行（這不是最有問題的，我可以處理多次重復它:)），但它不會將大小報告給目標表：

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

我希望我的解釋足夠清楚。 （抱歉我的英語可能不好，這不是我的母語！）

Answer 1

試試看：

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