如果列包含大于1的数字，则多次复制该行

好吧，所以我得到了这个工作，并添加了我的代码，以在同一个循环中更改另一列，我最后的挑战是看我的Q列，其中包含订购的项目的数量，如果它是> 1那么复制整行，然后将其粘贴到新插入的行中，但数量超过1个。 例

Josh Smith Soda 1 John Doe Banana 3 Tony Brown Cake 1 

将需要成为

 Josh Smith Soda 1 John Doe Banana 3 John Doe Banana 3 John Doe Banana 3 Tony Brown Cake 1 

我的代码到目前为止是：

 Sub prepLabels() Dim i As Long For i = 3 To Range("A2").End(xlDown).Row Step 1 If Cells(i, "Q") > 1 Then ActiveCell.EntireRow.Select Selection.Copy Selection.Insert Shift:=xlDown End If End If Next i End Sub 

但是很明显，我没有做出任何事情，因为我的第一排只是复制了7次。

Answer 1

插入行时，请始终从底部开始，朝向顶部，以便插入的行不会与您的迭代计数冲突。

 Sub prepLabels() Dim i As Long, r As Long, lr As Long With ActiveSheet 'define this worksheet properly! lr = .Cells(Rows.Count, 1).End(xlUp).Row For i = lr To 3 Step -1 For r = 2 To .Cells(i, "Q").Value2 .Cells(i + 1, 1).EntireRow.Insert .Cells(i, 1).Resize(2, Columns.Count).FillDown Next r Next i End With End Sub