1

2 つのワークシート (Month1 と Month2) があります。一致しないものを見つけて、一致しないものをコピーして 3 番目のワークシート (EndReport) に貼り付けようとしています。ただし、おそらくコードが原因で、まったく貼り付けられません...コピーアンドペーストコードを変更して機能させる方法を誰かがアドバイスできますか...大いにthx!

'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