Excel VBA 自动根据单元格值复制整行“X”次并粘贴到单独的工作表中

Question

Relatively new to VBA and the situation I've run into is I have a column A through Y that I need to copy and paste X number of times based on the numeric value in column O. I used the below code which worked fine for just copying into the separate sheet. The problem I'm running into now is I've changed so there is formulas in column A to make it a bit more dynamic; however, now the code is copying the formulas.

I did some more research on pastespecial but cannot seem to get my code to do the same as the first code below only pasting the value of the formula in column A instead. I'm not tied to copying the entire row but I do need columns AY. Any assistance is much appreciated!

Public Sub CopyData()
' This routing will copy rows based on the quantity to a new sheet.
Dim rngSinglecell As Range
Dim rngQuantityCells As Range
Dim intCount As Integer

' Set this for the range where the Quantity column exists. This works only if there are no empty cells
Set rngQuantityCells = Range("D1", Range("D1").End(xlDown))

For Each rngSinglecell In rngQuantityCells
    ' Check if this cell actually contains a number
    If IsNumeric(rngSinglecell.Value) Then
        ' Check if the number is greater than 0
        If rngSinglecell.Value > 0 Then
            ' Copy this row as many times as .value
            For intCount = 1 To rngSinglecell.Value
                ' Copy the row into the next emtpy row in sheet2
                Range(rngSinglecell.Address).EntireRow.Copy Destination:= Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)                                
                ' The above line finds the next empty row.

            Next
        End If
    End If
Next
End Sub

Also - I've lurked around this forum for some time and you all are amazing at what you do here and a great resource! Glad to have finally joined.

Answer 1

Try the refactored code below, which will accomplish your goal and most likely run faster, too.

Public Sub CopyData()

' This routing will copy rows based on the quantity to a new sheet.
Dim rngSinglecell As Range
Dim rngQuantityCells As Range
Dim intCount As Integer

' Set this for the range where the Quantity column exists. This works only if there are no empty cells
Set rngQuantityCells = Range("D1", Range("D1").End(xlDown))

For Each rngSinglecell In rngQuantityCells

    ' Check if this cell actually contains a number and if the number is greater than 0
    If IsNumeric(rngSinglecell.Value) And rngSingleCell.Value > 0 Then

        ' Copy this row as many rows as .value and 25 columns (because A:Y is 25 columns)
        Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(rngSinglecell.Value, 25).Value = _
            Range(Range("A" & rngSinglecell.Row), Range("Y" & rngSinglecell.Row)).Value

    End If
Next

End Sub