如果一行包含特定值，则将一行中的行复制到第二张

Question

我是VBA的新手，发现我认为是我的问题的答案但是没有用。如果我的Sheet1列F包含值"A - 6:30PM"，那么我希望将整行复制到第二张表。

这是我以前使用的代码。出了什么问题？

Sub Test()
  For Each Cell In Sheets(1).Range("F:F")
    If Cell.Value = "A - 6:30PM" Then
        matchRow = Cell.Row
        Rows(matchRow & ":" & matchRow).Select
        Selection.Copy

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

Answer 1

这是一种更干净的方法。 Dim ws As Excel.Worksheet

    Set ws = Application.ActiveSheet
    Dim lRow as Long

    'Starting at row 1 loop through each row of the used range.
    lRow = 1
    Do While lRow <= ws.UsedRange.Rows.Count

        If ws.Range("F" & lRow).Value = "A - 6:30PM" then

            Rows(lRow & ":" & lRow).Select
            Selection.Copy

            Sheets("A").Select
            ActiveSheet.Rows(lRow).Select
            ActiveSheet.Paste
            Sheets("A").Select

        End If

        lRow = lRow + 1
        ws.Range("A" & lRow).Activate
    Loop

我不确定您的粘贴代码如何知道将每行粘贴到哪一行。但是如果你需要跟踪要粘贴的行，只需为第二张表添加另一个计数器。

Dim ws As Excel.Worksheet
Set ws = Application.ActiveSheet
'Starting at row 1 loop through each row of the used range.
Dim lRow as Long
Dim lTargetRow as Long

lTargetRow = 1
lRow = 1
Do While lRow <= ws.UsedRange.Rows.Count

    If ws.Range("F" & lRow).Value = "A - 6:30PM" then
        Rows(lRow & ":" & lRow).Select
        Selection.Copy

        Sheets("A").Select
        ActiveSheet.Rows(lRow).Select
        ActiveSheet.Paste
        Sheets("A").Select

       lTargetRow = lTargetRow + 1
    End If

    lRow = lRow + 1
    ws.Range("A" & lRow).Activate
Loop

Answer 2

尝试在代码的最后使用Sheets("A").Select更改Sheets(1).Select。