如何根据日期标准将整行从一个源工作表复制到目标工作表并从源中删除行

Question

我正在使用一个由两张表组成的 excel 工作表。第一个源表名称是“已提交”，如下所示。

1. 我想从红色圆圈 (F) 列中搜索所有小于 today() 日期的行。
2. 如果找到行，我想将它们转移到下一个空白行上的目标工作表。在另一种情况下，如果未找到数据，则应关闭 sub 而无需执行任何操作。
3. 传输数据后，应从源工作表中删除详细信息行。

目标表如下所示。

我正在使用以下代码，但它没有按我的意愿工作。

    Sub MM1()
Dim Check As Range, r As Long, lastrow2 As Long, lastrow As Long
Application.ScreenUpdating = False
lastrow = Worksheets("Submitted").UsedRange.Rows.Count
lastrow2 = Worksheets("Agreements").UsedRange.Rows.Count
If lastrow2 = 1 Then lastrow2 = 0
    For r = lastrow To 2 Step -1
        If Range("F12" & r).Value <= Now() Then
            Rows(r).Cut Destination:=Worksheets("Agreements").Range("A" & lastrow2 + 1)
            lastrow2 = lastrow2 + 1
            Else:
        End If
    Next r
Application.ScreenUpdating = True
End Sub

请建议我最好的方法以及我做错的地方。谢谢

Answer 1

您应该尝试正确定义您的范围/行，否则它不会知道需要从哪里获取数据，例如Rows(r).Cut 应该是 Worksheets("Submitted").Rows(r).Cut。还要在开始时定义工作表，以保持代码精简并提供任何人都可以遵循的变量名称。

Sub MMM1()
Dim loop1 As Long, lastrow2 As Long, lastrow As Long
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsSub As Worksheet, wsAgr As Worksheet

Set wsSub = wb.Worksheets("Submitted")
Set wsAgr = wb.Worksheets("Agreements")

Application.ScreenUpdating = False
lastrow = wsSub.Cells(wsSub.Rows.Count, 1).End(xlUp).Row
lastrow2 = wsAgr.Cells(wsAgr.Rows.Count, 2).End(xlUp).Row

If lastrow2 = 1 Then lastrow2 = 0
    For loop1 = 12 To lastrow Step 1
        If wsSub.Range("F" & loop1).Value <= Date Then
            wsSub.Rows(loop1).Cut Destination:=wsAgr.Range("A" & lastrow2 + 1)
            lastrow2 = lastrow2 + 1
        End If
    Next loop1

Application.ScreenUpdating = True
End Sub