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

Question

VBA相对较新，我遇到的情况是我有一列A到Y，我需要复制并粘贴X次数基于列O中的数值。我使用下面的代码，它可以很好地复制到单独的工作表中。我现在遇到的问题是我改变了，所以A列中有公式使它更具动态性;但是，现在代码正在复制公式。

我对pastespecial做了一些更多的研究，但是似乎无法让我的代码与下面的第一个代码做同样的事情，而只是粘贴A列中公式的值。我不想复制整行，但我确实需要列A-Y。任何援助非常感谢！

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 

另外 - 我在这个论坛上潜伏了一段时间，你们都很惊讶于你在这里做什么和一个很好的资源！很高兴终于加入。

Answer 1

尝试下面的重构代码，这将实现您的目标，并且最有可能运行得更快。

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