VBA：不需要的覆盖行

已经有几天了，我在互联网上搜索我的应用程序的正确代码/帮助。 情况：如果某个客户的某个产品已经完成，第9栏给出“准备就绪”。发生这种情况时，整行必须移动到“历史记录”列表中的第2页，并从“最新”列表中消失

我的代码是下一个：

子移动删除（）

端接头

此代码正在工作，但会出现其他问题。假设今天我的范围是40，应该将3行移到第二个工作表中，它们被放置在第40、39和38行（而不是1、2、3行更好）。但例如，明天我在最新列表中添加5行，可以再次删除4行旧行，这将覆盖以前的行（但我希望它们位于4、5、6和7）

我的目标是有一个清单，我可以每天更新，这样生产线就可以清楚地看到工作量，并在第二页列出上个月完成的所有产品/客户信息

---

我希望有人能帮我。如果有更多问题，请随时提问！非常感谢

您可以将新移动的行附加到sheet2中已存在的行的末尾

Sub MoveDelete()
    Dim i As Integer, y As Integer, j as Integer
    Application.ScreenUpdating = False

    'Find first free row in sheet2
    j = Worksheets(2).cells(Rows.Count, 9).End(xlUp).Row + 1
    i = ActiveSheet.cells(Rows.Count, 9).End(xlUp).Row

    For y = i To 1 Step -1
        If Cells(y, 9).Value = "Mag weg" Then
            Rows(y).Copy Worksheets(2).Rows(j)
            Rows(y).EntireRow.Delete
            j = j + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Sub MoveDelete()
    Dim i As Integer, y As Integer, j as Integer
    Application.ScreenUpdating = False

    'Find first free row in sheet2
    j = Worksheets(2).cells(Rows.Count, 9).End(xlUp).Row + 1
    i = ActiveSheet.cells(Rows.Count, 9).End(xlUp).Row

    For y = i To 1 Step -1
        If Cells(y, 9).Value = "Mag weg" Then
            Rows(y).Copy Worksheets(2).Rows(j)
            Rows(y).EntireRow.Delete
            j = j + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub