我的循环正在使用下一步跳一排

Question

先谢谢了。 我有这个VBA代码，我已经运行了很长时间了，但是它没有按预期工作。我有一些公式可以划分一些值，如果符合条件，此代码的目的是将所有信息发送到另一个Tab中，以便保护我的数据。

问题是，每当我运行宏时，“ Next”功能都会在复制第一行后跳转到下一行，因此我无法复制并粘贴所有符合条件的行条件。

代码如下：

Sub ENTREGUES()

Application.ScreenUpdating = False
Dim Answer As VbMsgBoxResult
Answer = MsgBox("Gostaria de Enviar as Entregas Finalizadas?", vbQuestion + 
vbYesNo + vbDefaultButton2, "TRACKING >>> ENTREGUES")
If Answer = vbNo Then Exit Sub

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim wsT As Worksheet, wsD As Worksheet
Set wsT = Sheets("TRACKING")
Set wsD = Sheets("ENTREGUES")

wsT.Unprotect "sds"
wsD.Unprotect "sds"

Dim lastrowT as Long, nextrowD As Long

lastrowT = WorksheetFunction.CountA(wsT.Range("D:D")) + 6

For i = 6 To lastrowT

    If wsT.Cells(i, "AS").Value <> "" Then
        wsT.Rows(i).Copy
            wsT.Rows(i).Copy
            nextrowD = WorksheetFunction.CountA(wsD.Range("D:D")) + 3
                wsD.Cells(nextrowD, 1).PasteSpecial xlPasteValues
        wsT.Rows(i).Delete
    End If

Next i

wsT.Protect "sds", True, True
wsD.Protect "sds", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowSorting:=True, AllowFiltering:=True

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

以下是图像，因此您可以看到“我下次运行”时跳转到下一行：

图片：

然后它一直跳跃直到End Sub离开（在示例中）落后3行。

我一直在努力寻找解决方案达三天之久，无法解决。

我试图更改VBA计算行的方式或尝试在复制之前选择所有行，但是我没有成功。

有人可以启发我我想念的是什么吗？

非常感谢。

Answer 1

在删除行时，您应该从下到上循环，因为当删除一行时，下面的行将上移一行，因此，For循环会错过该行，但是如果您的For循环是从下向上，则行向上移动，它们仍然包含在循环中，如下所示：

NILSXP