【マクロ・VBA】アクティブシートと右隣りのシートの差異をディクショナリで調べてそれぞれを新規シートに転記

Sub キー不一致確認()

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
.DisplayAlerts = False
.EnableCancelKey = xlErrorHandler
End With

Dim x As Long
Dim y As Long
Dim A As Variant, b As Variant

Dim rngWS1 As Range
Dim rngWS2 As Range
Dim dicIndex As Object

'基シート
With ActiveSheet
    Set rngWS1 = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
End With

'変数にデータ範囲の値を配列として取得します
A = rngWS1.Value

'セルのFontColorとBackColorを標準に
rngWS1.Interior.Pattern = xlNone
rngWS1.Font.ColorIndex = xlAutomatic

'相手シート
With ActiveSheet.Next
    Set rngWS2 = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
     
'変数に相手シートのデータ範囲の値を配列として取得します
b = rngWS2.Value
    
Set dicIndex = CreateObject("Scripting.Dictionary")
With dicIndex
    For x = 1 To UBound(b, 1)
         .Item(b(x, 1)) = Empty
    Next x
End With

'相手シートにあって基シートにないものをキー番号に色を付けて新規シートに転記
Worksheets.Add After:=ActiveSheet
ActiveSheet.Name = "相手有り-基無し"

For x = 1 To UBound(A, 1)
    DoEvents
    If Not dicIndex.Exists(A(x, 1)) Then
        With rngWS1.Item(x, 1)
            .Interior.ColorIndex = 36 '19
            .EntireRow.Copy ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End With
    End If
Next x


'相手シートになし、基シートありのキー番号に新規シートに転記
Worksheets.Add After:=ActiveSheet
ActiveSheet.Name = "相手無し-基あり"

For x = 1 To UBound(A, 1)
    DoEvents
    If dicIndex.Exists(A(x, 1)) Then
        With rngWS1.Item(x, 1)
            '.Interior.ColorIndex = 36 '19
            .EntireRow.Copy ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End With
    End If
Next x

Set dicIndex = Nothing
Set rngWS1 = Nothing
Set rngWS2 = Nothing

'オートフィルタで抽出する場合
'Range("A1").AutoFilter Field:=1, _
'Criteria1:=RGB(255, 255, 204), _
'Operator:=xlFilterCellColor

'項目コピー
'Sheets("項目").Rows(1).Copy ActiveSheet.Rows(1)  

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.DisplayAlerts = True
End With

MsgBox "完了 "
End Sub