Question

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

您可以使用Range对象，而不是一次使用 复制＆gt;＆gt;粘贴 一行，这需要很长时间才能处理名为CopyRng。

每次符合条件（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

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

e.g。如果您将目标表定义为wsDest，则可以替换

Name,One,Two,Three,Four,Five
Name,six,Seven,Eight,Nine,Ten
Name,Eleven,Twelve,Thirteen

通过

ws4.Rows(y).EntireRow.Copy

假设您在第1列中始终有值。

另一种选择是在B列上执行自动过滤，找不到值，并使用ws4.Rows(y).EntireRow.Copy wsDest.cells(rows.count,1).end(xlup).offset(1)属性复制到另一个位置。录制宏将对您有所帮助，但代码将类似于：

specialcells

Answer 3

您正在复制，但没有粘贴行。

示例，粘贴行目标为ws1.Cells(counter,"B")，假设另一个工作表变量ws1可能是：

 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 e.g. 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

基于Vba中的某些条件复制行的问题

3 个答案: