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

Question

对

VBA 来说相对较新，我遇到的情况是我有一列 A 到 Y，我需要根据 O 列中的数值复制和粘贴 X 次。 我使用了下面的代码，它适用于复制到单独的工作表中。 我现在遇到的问题是我已经更改了，因此 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