Question

我正在寻找一个可以搜索所述表格中的列的marco，如果找到某些文本 - 在我的例子中是“FAIL” - 复制整行数据/格式化并将其粘贴到另一个在我的情况下表单4 - 以及包含该特定文本的任何其他行。

我一直在使用这段代码，但它只复制粘贴一行然后停止而不是通过“FAIL”复制任何行

Sub Test()
For Each Cell In Sheets(1).Range("H:H")
  If Cell.Value = "FAIL" Then
    matchRow = Cell.Row
    Rows(matchRow & ":" & matchRow).Select
    Rows(matchRow & ":" & matchRow).Select
    Selection.Copy

    Sheets(4).Select
    ActiveSheet.Rows(matchRow).Select
    ActiveSheet.Paste
    Sheets(4).Select
   End If
Next 
End Sub

VBA的第一篇文章和全新的内容如果过于模糊，请道歉。

Answer 1

试试这样：

Option Explicit

Sub TestMe()

    Dim Cell As Range
    Dim matchRow As Long

    With Worksheets(1)    
        For Each Cell In .Range("H:H")
            If Cell.Value = "FAIL" Then
                matchRow = .Cell.Row
                .Rows(matchRow & ":" & matchRow).Select
                .Rows(matchRow & ":" & matchRow).Select
                Selection.Copy        
                Worksheets(4).Select
                Worksheets(4).Rows(matchRow).Select
                Worksheets(4).Paste
                .Select
            End If
        Next        
    End With
End Sub

代码中的问题是您没有正确引用工作表。因此它无法正常工作。

作为第2步，您可以尝试避免代码中的所有选择，最好避免在Excel VBA中使用“选择”或“激活”。

Answer 2

尝试下面的代码（代码中的注释作为注释）：

Option Explicit

Sub Test()

Dim Cell As Range

With Sheets(1)
    ' loop column H untill last cell with value (not entire column)
    For Each Cell In .Range("H1:H" & .Cells(.Rows.Count, "H").End(xlUp).Row)
        If Cell.Value = "FAIL" Then
             ' Copy>>Paste in 1-line (no need to use Select)
            .Rows(Cell.Row).Copy Destination:=Sheets(4).Rows(Cell.Row)
        End If
    Next Cell
End With

End Sub

Excel：如果行包含某些文本到另一个工作表（VBA）如何复制行

2 个答案: