VBA - comparaison 2 feuilles Excel et liste différences dans autre feuille

Bonjour, j'essaie de faire une macro VBA qui permet de comparer deux feuilles Excel et afficher les résultats dans une feuille Résultats. Le programme ne fonctionne pas

Option Explicit

Sub CompareIt() 'Excel VBA with scripting dictionary to compare sheets
Dim ar As Variant
Dim arr As Variant
Dim Var As Variant
Dim v()
Dim i As Long
Dim n As Long
Dim j As Long
Dim str As String

ar = Sheets("TiersM-1").Cells(10, 1).CurrentRegion.Value

With CreateObject("Scripting.Dictionary")
.CompareMode = 1
ReDim v(1 To UBound(ar, 2))
For i = 2 To UBound(ar, 1)
For n = 1 To UBound(ar, 2)
str = str & Chr(2) & ar(i, n)
v(n) = ar(i, n)
Next
.item(str) = v: str = ""
Next

ar = Sheets("TiersM").Cells(10, 1).CurrentRegion.Resize(, UBound(v)).Value

For i = 2 To UBound(ar, 1)
For n = 1 To UBound(ar, 2)
str = str & Chr(2) & ar(i, n)
v(n) = ar(i, n)
Next

If .exists(str) Then
.item(str) = Empty
Else
.item(str) = v
End If
str = ""
Next

For Each arr In .keys
If IsEmpty(.item(arr)) Then
.Remove arr
Next
Var = .items: j = .count
End With
With Sheets("resultats").Range("a1").Resize(, UBound(ar, 2))
.CurrentRegion.ClearContents
.Value = ar
If j > 0 Then
.Offset(1).Resize(j).Value = Application.Transpose(Application.Transpose(Var))
End If
End With
End Sub

Bonjour,

Dans cette section il manque End if

For Each arr In .keys
If IsEmpty(.item(arr)) Then
.Remove arr
Next
Var = .items: j = .count
End With

A+

Non cela ne résout pas le problème. Le problème vient du For.