在Vba中根据特定条件复制行时出现问题

Set ws4 = Workbooks("A.xlsx").Worksheets(1) Lastrowto = ws4.Cells(Rows.Count, "B").End(xlUp).Row For y = Lastrowto To 1 Step -1 If ws4.Cells(y, "B").Value = "Not found" Then ws4.Rows(y).EntireRow.Copy End If Next y 

上面的vba代码块只复制1（第一个）行，但我想复制所有这些行满足给定的条件，请告诉我正确的代码版本。

Answer 1

而不是一次使用复制>>粘贴一行，这将需要很长时间来处理，您可以使用名为CopyRng的Range对象。

每次满足条件（ If .Range("B" & y).Value = "Not found" ），它会将当前行添加到CopyRng 。

循环遍历所有行之后，可以使用CopyRng.Copy一次性复制整个行。

码

 Option Explicit Sub CopyMultipleRows() Dim ws4 As Worksheet Dim Lastrowto As Long, y As Long Dim CopyRng As Range Set ws4 = Workbooks("A.xlsx").Worksheets(1) With ws4 Lastrowto = .Cells(.Rows.Count, "B").End(xlUp).Row For y = Lastrowto To 1 Step -1 If .Range("B" & y).Value = "Not found" Then If Not CopyRng Is Nothing Then Set CopyRng = Application.Union(CopyRng, .Rows(y)) Else Set CopyRng = .Rows(y) End If End If Next y End With ' copy the entire rows of the Merged Range at once If Not CopyRng is Nothing Then CopyRng.Copy End Sub 

Answer 2

你想把它复制到哪里？ 如果你指定一个目的地到你的副本，那么你的代码可以工作。

例如，如果您将目标工作表定义为wsDest，则可以replace

 ws4.Rows(y).EntireRow.Copy 

通过

 ws4.Rows(y).EntireRow.Copy wsDest.cells(rows.count,1).end(xlup).offset(1) 

假设你在第1栏中总是有一个值。

另一个select是在列B上执行自动筛选，找不到该值，并使用specialcells属性复制到另一个点。 录制一个macros会帮助你很多，但是代码会是这样的：

 with ws4.cells(1,1).currentregion .autofilter field:=2,criteria1:="Not found" .specialcells(xlcelltypevisible).copy end with 

Answer 3

你正在复制，但没有粘贴线。

以ws1.Cells(counter,"B")的粘贴行目标ws1.Cells(counter,"B") ，假设另一个工作表variablesws1可能是：

  ws4.Rows(y).EntireRow.Copy ws1.Cells(counter,"B") 

每当你进入循环，并且已经满足条件时，请参阅以下内容，msgbox显示你正在复制：

 Public Sub test1() Dim ws4 As Worksheet Dim lastrowto As Long Dim y As Long Dim counter As Long Set ws4 = ThisWorkbook.Worksheets("Ben") lastrowto = ws4.Cells(ws4.Rows.Count, "B").End(xlUp).Row 'fully qualify counter = 0 For y = lastrowto To 1 Step -1 If ws4.Cells(y, "B").Value = "Not found" Then ws4.Rows(y).EntireRow.Copy 'put paste destination code here eg ws1.Cells(counter,"B") where ws1 would be another sheet variable counter = counter + 1 Msgbox counter 'if has entered loop print current count End If Next y End Sub