在Excel中，如何生成一个拷贝X行多less次？

在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 

任何提示赞赏，谢谢！

Answer 1

据我可以告诉你正在试图做到这一点 –

 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