根据值将一行复制到另一行

时间:2017-08-04 05:35:46

标签: excel vba excel-vba

我正在尝试将数据从一个工作表复制到另一个工作表,具体取决于列值。我运行了下面的代码,但由于某种原因,我可以看到从52行粘贴的列。

我希望每次都将它们粘贴在2张纸上。有人可以帮我解决问题吗?

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行粘贴。请帮我解决这个问题

1 个答案:

答案 0 :(得分: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