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