Vba 在Excel中，如何生成一份X行的副本？

在Excel中，我需要为批量上传生成文件，其中包含1K、5K、10K和100K行。所以我看了VBA脚本。以下是关于：

Private Sub CommandButton21_Click()

    ' 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 cut out rngSinglecell DOT Value
                For intCount = 1 To 1000
                    ' 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

但我想做的是复制一行从

A15

到

Y15

的数据，然后将其粘贴到工作表中，这样我就可以将其复制粘贴回原始工作表（用于iProcurement中的批量上传）

出于某种原因，我的行只被复制了两次，即使我将intcount更改为以下值：

For intCount = 1 To 1000

---

任何提示，谢谢

据我所知，你正试图这么做-

Sub test()
    ' This routing will copy rows based on the quantity to a new sheet.

    Dim lastrow As Integer
    lastrow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row

    ' Set this for the range where the Quantity column exists. This works only if there are no empty cells

    Dim destlastrow As Integer
    destlastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
    ' The above line finds the next empty row.
    For i = 1 To lastrow
        ' Check if this cell actually contains a number
        If IsNumeric(Cells(i, 4)) Then
            ' Check if the number is greater than 0
            If Cells(i, 4) > 0 Then
                ' Copy this row as many times as .value cut out rngSinglecell DOT Value
                For j = 1 To Cells(i, 4).Value
                    ' Copy the row into the next emtpy row in sheet2
                    Cells(i, 4).EntireRow.Copy Destination:=Sheets("Sheet2").Cells(destlastrow, 1)
                    destlastrow = destlastrow + 1

                Next
            End If
        End If
    Next

End Sub

---

您在同一输出行上复制了1000次。是否要复制D列中单元格指定的次数？@rbaryyoung-好的，我将再次研究，谢谢@雷斯塔法里安-我不确定我明白你的意思。>的D列是什么？您指定了D列。我不确定您使用此宏的目的是什么。