如何根据是否将一行复制到另一张工作表

Question

我正在尝试编写一个宏，如果满足某些值，它将复制一行到另一张纸。 有多个可能的目的地。 这是我拼凑而成的，但是我确定它很杂乱。 基本上，如果第14列中有“ N / A”，而在第8列中有“ APP”，则将其复制到APP选项卡。 以此类推，例如安吉（Angie），凯茜（Cathy）等

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Reconciliation")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("APP")
Dim ws3 As Worksheet: Set ws3 = ThisWorkbook.Sheets("Angie")
Dim ws4 As Worksheet: Set ws4 = ThisWorkbook.Sheets("Cathy")
Dim ws5 As Worksheet: Set ws5 = ThisWorkbook.Sheets("Cory")
Dim ws6 As Worksheet: Set ws6 = ThisWorkbook.Sheets("Curt")

For Each i In ws1.Range("A1:A1000")
    If ws1.Cells(i, 14) = "#N/A" Then
        If ws1.Cells(i, 8) = "APP" Then
            ws1.Rows(i).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)
        End If
    End If
Next i

Answer 1

如果存在名称匹配的工作表，则会复制该行：

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Reconciliation")
Dim ws

For Each i In ws1.Range("A1:A1000").Cells
    If ws1.Cells(i.Row, 14).Value = cverr(2042) Then
            Set ws = Nothing
            On Error Resume Next
            Set ws = ThisWorkbook.Sheets(ws1.Cells(i.Row, 8).Value)
            on error goto 0
            If Not ws Is Nothing Then            
                i.EntireRow.Copy ws.Rows(ws.Cells(ws.Rows.Count, 2).End(xlUp).Row + 1)
            End If
        on error goto 0
    End If
Next i