![](/img/trans.png)
[英]Excel VBA automation - copy row "x" number of times based on cell value
[英]Excel VBA automation copy entire row “X” times based on cell value and paste in separate sheet
VBA 相對較新,我遇到的情況是我有一個 A 列到 Y 列,我需要根據 O 列中的數值復制和粘貼 X 次。我使用了以下代碼,該代碼僅適用於復制到單獨的工作表中。 我現在遇到的問題是我已經改變了,所以 A 列中有公式,使其更具動態性; 但是,現在代碼正在復制公式。
我對 pastespecial 進行了更多研究,但似乎無法讓我的代碼與下面的第一個代碼一樣,只是將公式的值粘貼到 A 列中。 我不依賴於復制整行,但我確實需要 AY 列。 非常感謝任何幫助!
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
另外 - 我已經潛伏在這個論壇一段時間了,你們都對自己在這里所做的事情和很棒的資源感到驚訝! 很高興終於加入。
試試下面的重構代碼,這將實現你的目標,而且很可能運行得更快。
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.