1

我有两个工作表（Month1 和 Month2）。我正在尝试查找不匹配项，然后将不匹配项复制并粘贴到第三个工作表（EndReport）中。但是，它根本没有粘贴可能是由于代码......有人可以建议我如何修改我的复制和粘贴代码以使其工作......非常感谢！

'Search for Non-Matched IO Series of Month 2 and populate the data into EndReport

Dim iNON As Long
Dim arrSum As Variant, arrUsers As Variant
Dim cUnique As New Collection

'Put the name range from "Month2" in an array
With ThisWorkbook.Sheets("Month2")
    arrSum = .Range("A3", .Range("A" & Rows.Count).End(xlUp))
End With

'"Convert" the array to a collection (unique items)
For iNON = 1 To UBound(arrSum, 1)
    On Error Resume Next
    cUnique.Add arrSum(iNON, 1), CStr(arrSum(iNON, 1))
Next iNON

'Get the users array
With ThisWorkbook.Sheets("Month1")
    arrUsers = .Range("A3", .Range("A" & Rows.Count).End(xlUp))
End With

'Check if the value exists in the Month1 sheet
For iNON = 1 To cUnique.Count
    'if can't find the value in the users range, delete the rows
    If Application.WorksheetFunction.VLookup(cUnique(iNON), arrUsers, 1, False) = "#N/A" Then
        With ThisWorkbook.Sheets("Month2").Cells
            .AutoFilter Field:=1, Criteria1:=cUnique(iNON)
            .Range("A3", .Range("A" & Rows.Count).End(xlUp)).EntireRow.Copy
        End With


        Sheets("EndReport").Activate
        Sheets("EndReport").Select
        ThisWorkbook.Sheets("EndReport").Cells.Range("A3", Range("A" & Rows.Count).End(xlUp)).Paste Paste:=xlPasteValues

        Worksheets("EndReport").Range("A" & Worksheets("EndReport").Range("A65536").End(xlUp).Row & "").Offset(1, 0).Select
    End If
Next iNON

'removes AutoFilter if one remains
ThisWorkbook.Sheets("Month2").AutoFilterMode = False
4

0 回答 0