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

我试图根据几个标准将行复制到新的工作表中。

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

有一些解决这个在stackoverflow – 我search的东西，如“复制到一个新的行中的空行”等 – 但我不能让他们的工作只是复制这些答案中的一些代码（没有正确理解代码）。

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

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 

这将find您的工作表3的最后一个使用的行，并将其粘贴在它下面。

希望这可以帮助。