[英]Copy row to next empty row of another sheet
我正在嘗試根據幾個條件將行復制到新表中。
我設法編寫了一個宏,該宏可以找到一行並將其復制到新表中,但是不幸的是,我覆蓋了以前的條目。
在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
您只需要在新表中再次使用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的最后使用的行,並將其粘貼到它下面。
希望這可以幫助。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.