VB-在Excel中复制和粘贴嵌套循环

Question

所以我有一个问题，这是用Qty生成随机结果。

我正在努力使每个数量(在他们的数量(在一个新的电子表格上有一个新行。

它创建新的工作表，并引用旧的工作表。。。代码复制并粘贴行。。。它只是没有在正确的次数内循环do while。我尝试了不同的操作数(>=0(，并更改了变量值以使其工作。

对于为什么会发生这种情况，似乎没有形成模式。有时它会在正确的循环周期内完成，而另一些则不会。这种情况发生在多个值上。非常感谢您的帮助。

Sub copyPasta()
'
' copyPasta Macro
' This will take the qty, if greater than one  in Column C and copy the row 
'to a new sheet the amount of time the qty.
'
'
'Set Variable Types
Dim lineItemQty As Integer
Dim newLineItemQty As Integer
Dim LastRow As Integer
Dim strSheetName As String
Dim newSheetName As String
Dim i As Integer
Application.DisplayAlerts = False
'name a variable after the existing active sheet
strSheetName = ActiveSheet.Name
'add a sheet in addition to the current
Sheets.Add After:=ActiveSheet
'set a variable used in loops to the sheet being copied to
newSheetName = ActiveSheet.Name
'Return to first sheet
Sheets(strSheetName).Activate
' Set For Loop to max row
LastRow = Sheets(strSheetName).Range("C:C").Find("*", searchdirection:=xlPrevious).Row
'for loop to run through all rows
For i = 3 To LastRow Step 1
'initializing variable to Qty value in table
lineItemQty = Range("C" & i).Value
'initializing variable within in line of for looping
newLineItemQty = lineItemQty
'do while loop to keep copying/pasting while there are still qty's
Do While newLineItemQty > 0
'do while looped copy and paste
'copy the active row
Sheets(strSheetName).Activate
Rows(i).Select
Selection.Copy
'paste active row into new sheet
Sheets(newSheetName).Select
Rows("3:3").Select
Selection.Insert Shift:=xlDown

newLineItemQty = newLineItemQty - 1
Loop
Next i
Application.DisplayAlerts = True
End Sub

Answer 1

您可以考虑使用(或从中提取零件(以下替代方案。有几张值得注意的钞票是

1. 您应该避免使用.Select和.Activate。有关详细信息，请参阅此处
2. 当你声明短变量时，生活会更轻松。这里我们只有ws用于worksheet，ns用于newsheet。然后，您需要在代码中主动声明要重定向到哪个工作表(而不是使用.Select或.Activate，在所有对象前面加上适当的工作表变量(
3. 您不需要在循环中添加Step 1。这是默认值-您只需要在偏离默认值时添加它
4. 添加图纸有几种方法。你的做法没有错——这里只是一个替代方法(耶，学习(，这恰好是我喜欢的方法
5. 要多次复制n，只需为1 to n创建一个嵌套循环和。请注意，我们从未在循环中真正使用变量n，这意味着将执行完全相同的操作，我们只希望它执行n次

---

Sub OliveGarden()
Dim ws As Worksheet: Set ws = ThisWorkbook.ActiveSheet
Dim ns As Worksheet: Set ns = ThisWorkbook.Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count))
ns.Name = ws.Name & " New"
Dim i As Long, c As Long
'Application.ScreenUpdating = False
For i = 3 To ws.Range("C" & ws.Rows.Count).End(xlUp).Row
If ws.Range("C" & i) > 0 Then
For c = 1 To ws.Range("C" & i)
LRow = ns.Range("A" & ns.Rows.Count).End(xlUp).Offset(1).Row
ws.Range("C" & i).EntireRow.Copy
ns.Range("A" & LRow).PasteSpecial xlPasteValues
Next c
End If
Next i
'Application.ScreenUpdating = True
End Sub