将行复制到另一个工作表的下一个空行

Question

我正在尝试根据几个条件将行复制到新工作表中。

我设法编写了一个可以找到一行并将其复制到新工作表的宏，但不幸的是我覆盖了以前的条目。

在 stackoverflow 上有一些解决方案 - 我搜索了诸如“将行复制到空行中的新工作表”等内容 - 但我只是无法通过复制这些答案中的一些代码来使它们工作（没有正确理解代码）。

如何将结果复制到新工作表中的下一个空行？

Sub FilterAndCopy()

Dim lastRow As Long
Dim criterion As String
Dim team1 As String
Dim team2 As String
Dim team3 As String

criterion = "done"
team1 = "source"
team2 = "refine"
team3 = "supply"


Sheets("Sheet3").UsedRange.Offset(0).ClearContents

With Worksheets("Actions")
    .range("$A:$F").AutoFilter
    'filter for actions that are not "done"
    .range("$A:$F").AutoFilter field:=3, Criteria1:="<>" & criterion
    'filter for actions where "due date" is in the past
    .range("$A:$F").AutoFilter field:=6, Criteria1:="<" & CLng(Date)

    'FIRST TEAM
    .range("$A:$F").AutoFilter field:=4, Criteria1:="=" & team1
    'iff overdue actions exist, copy them into "Sheet3"
    lastRow = .range("A" & .rows.Count).End(xlUp).row
    If (lastRow > 1) Then
        .range("A1:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Sheets("Sheet3").range("A1")
    End If

    'SECOND TEAM
    .range("$A:$F").AutoFilter field:=4, Criteria1:="=" & team2
    'iff overdue items exist, copy them into "Sheet3"
    lastRow = .range("A" & .rows.Count).End(xlUp).row
    If (lastRow > 1) Then
        'find last row with content and copy relevant rows
        .range("A1:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Sheets("Sheet3").range("A1")
    End If

    'THIRD STREAM
    .range("$A:$F").AutoFilter field:=4, Criteria1:="=" & team3
    'iff overdue items exist, copy them into "Sheet3"
    lastRow = .range("A" & .rows.Count).End(xlUp).row
    If (lastRow > 1) Then
        'find last row with content and copy relevant rows
        .range("A1:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Destination:=Sheets("Sheet3").range("A1")
    End If

End With
End Sub

Answer 1

您只需在新工作表中再次使用您的 LastRow 代码。

所以试试

If (lastRow > 1) Then
    LastRow2 = worksheets("Sheet3").range("A" & rows.count).end(xlup).row + 1
    'find last row with content and copy relevant rows
    .range("A1:A" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
        Destination:=Sheets("Sheet3").range("A" & LastRow2)
End If

这会找到工作表 3 的最后使用的行并将其粘贴到它的下方。

希望这会有所帮助。