如何根据if复制行到另一个工作表

时间:2013-11-19 17:16:05

标签: excel vba excel-vba

我正在尝试编写一个宏,如果满足某些值,会将行复制到另一个工作表。有多个可能的目的地。这就是我拼凑的东西,但我确定它很混乱。基本上,如果在第14列中存在“N / A”并且在第8列中存在“APP”,则将其复制到APP选项卡。对于安吉,凯茜等等。

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

1 个答案:

答案 0 :(得分:0)

如果有一个匹配名称的工作表,则会复制该行:

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