基于值复制一行到另一行

我正在试图从一个表复制我的数据到另一个取决于列值。 我有下面的代码运行，但由于某种原因，我可以看到从52行粘贴的列。

每次我都想把它们粘贴在表格的第二行。 有人可以帮助我与代码绑定吗？

Sub list() Dim cell As Range Dim nextrow As Long Application.ScreenUpdating = False For Each cell In Sheets("BW").Range("T5:T" & Sheets("BW").Cells(Sheets("BW").Rows.Count, "T").End(xlUp).Row) If cell.Value = "1" Then nextrow = Sheets("PSW").Cells(Sheets("PSW").Rows.Count, "T").End(xlUp).Row Rows(cell.Row).Copy Destination:=Sheets("PSW").Range("A" & nextrow + 1) End If Next Application.ScreenUpdating = True End Sub 

我每次都检查T列，如果它是我的工作表BW中的一个，我把整行粘贴到工作表PSW。每次从52行粘贴。 请帮我解决这个问题

Answer 1

你能否检查你的PSW表格T列是否有数据。

或者您可以使用CountA来获得比使用Cells(Sheets("BW").Rows.Count, "T")获得行号更好的清晰度。

 Sub list() Dim cell As Range Dim nextrow As Long Dim a As Double Application.ScreenUpdating = False a = Application.WorksheetFunction.CountA(Sheets("BW").Range("T:T")) For Each cell In Sheets("BW").Range("T5:T" & a) If cell.Value = "1" Then nextrow = Application.WorksheetFunction.CountA(Sheets("PSW").Range("T:T")) Rows(cell.Row).Copy Destination:=Sheets("PSW").Range("A" & nextrow + 1) End If Next Application.ScreenUpdating = True End Sub