Vba 使用案例选择将其剪切并粘贴到图纸中

我不熟悉编写宏，并尝试为工作编写宏。下面是我一直在使用的一段代码。我希望它查看表格“NG304”，并找到列在B列中的关键字。如果有关键字，请将它们移动到第二个电子表格“工资单详细信息”。我遇到的问题-代码没有贯穿整个列表，并且似乎没有粘贴到工资明细电子表格的下一行（它将简单地粘贴到我的标题顶部）

代码：

---

这将过滤K_WORDS（顶部）中定义的每个值，并将行移动到另一个工作表：

---

---

这正是我需要的！我将使用K_Words函数，因为我有一些关键字要查找。非常感谢你的帮助！

Dim Findme As String, Findwhat As String, c As Range

With ActiveWorkbook.Worksheets("NG304")

        For Each c In .Range(.Cells(2, "B"), .Cells(Rows.Count, "B").End(xlUp))
            Findwhat = vbNullString
            Findme = StrConv(c.Value2, vbProperCase)
            Select Case True
                Case Findme Like "VCIP"
                    Findwhat = "VCIP"
                Case Findme Like "Company Labor"
                    Findwhat = UCase(Findme)
                Case Else
                    'do nothing
            End Select

       If CBool(Len(Findwhat)) Then
                With .Parent.Worksheets("NG304")
                    c.EntireRow.Cut Destination:=Worksheets("Payroll Detail").Range("A" & lastrow + 1)
            lastrow = lastrow + 1
                End With
            End If
        Next c


    End With

Option Explicit

Public Sub moveKeywordRows()
    Const K_WORDS  As String = "VCIP,Company Labor"      '<------- Defined keywords

    Dim wsFrom As Worksheet, wsDest As Worksheet, kw As Variant, i As Long, lr As Long

    Set wsFrom = ThisWorkbook.Worksheets("NG304")
    Set wsDest = ThisWorkbook.Worksheets("Payroll Detail")
    kw = Split(K_WORDS, ",")

    Application.ScreenUpdating = False
    For i = 0 To UBound(kw)
        lr = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Row
        With wsFrom.UsedRange
            .AutoFilter Field:=2, Criteria1:="=" & kw(i)
            .Copy
            wsDest.Cells(lr, "A").PasteSpecial xlPasteAll
            .SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
        Application.CutCopyMode = False
        wsDest.Activate:    wsDest.Cells(1, "A").Select
    Next

    wsDest.UsedRange.EntireColumn.AutoFit
    With wsFrom
        .Activate   'wsFrom.UsedRange.AutoFilter '.ShowAllData
    End With
    Application.ScreenUpdating = True
End Sub

Public Sub moveKeywordRows1()
    Dim FindMe As String, FindWhat As String, c As Range, lr As Long, wsDest As Worksheet

    Set wsDest = ThisWorkbook.Worksheets("Payroll Detail")
    With ThisWorkbook.Worksheets("NG304")
        Application.ScreenUpdating = False
        For Each c In .Range(.Cells(2, "B"), .Cells(.Rows.Count, "B").End(xlUp))
            FindMe = StrConv(c.Value2, vbProperCase)
            FindWhat = vbNullString
            Select Case UCase(FindMe)
                Case "VCIP":                    FindWhat = "VCIP"
                Case UCase("Company Labor"):    FindWhat = "Company Labor"
            End Select
            If Len(FindWhat) > 0 Then
                c.EntireRow.Cut Destination:=wsDest.Range("A" & lr + 1)
                lr = lr + 1
            End If
        Next
        Application.ScreenUpdating = True
    End With
End Sub