Comparer deux onglets dans un fichier + extraction des differences dans un autre onglet

Sub DiffUser()
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
Dim i As Long, j As Long, Tablo1, Tablo2, TabFin, Dico1, Dico2, Ident As Boolean
Set Dico1 = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")

Set WS1 = Worksheets(1)
Set WS2 = Worksheets(2)
Set WS3 = Worksheets(3)
Tablo1 = WS1.Range("A3:Q" & WS1.Range("A" & Rows.Count).End(xlUp).Row)
Tablo2 = WS2.Range("A3:Q" & WS2.Range("A" & Rows.Count).End(xlUp).Row)

For i = LBound(Tablo1) To UBound(Tablo1)
    Dico1(Tablo1(i, 1)) = Application.Index(Tablo1, i)
Next
For i = LBound(Tablo2) To UBound(Tablo2)
    Dico2(Tablo2(i, 1)) = Application.Index(Tablo2, i)
Next

For i = LBound(Tablo1) To UBound(Tablo1)
    Ident = True
    If Dico2.exists(Tablo1(i, 1)) Then
        For j = 1 To UBound(Dico1(Tablo1(i, 1)))
            If Dico1(Tablo1(i, 1))(j) <> Dico2(Tablo1(i, 1))(j) Then
                Ident = False
                Exit For
            End If
        Next
        If Ident Then
            Dico1.Remove (Tablo1(i, 1))
            Dico2.Remove (Tablo1(i, 1))
        End If
    Else
        Dico2(Tablo1(i, 1)) = Application.Index(Tablo1, i)
    End If

Next
If Dico2.Count > 0 Then
    With WS3.Range("A3")
    .Resize(Dico2.Count, 17) = Application.Transpose(Application.Transpose(Dico2.items))
    .Resize(Dico2.Count, 17).Borders.Value = 1
    .Offset(Dico2.Count + 1, 0) = "Nb total différences ="
    .Offset(Dico2.Count + 1, 3) = Application.CountA(WS3.Range("B3:Q" & Dico2.Count + 2))
    End With
End If
End Sub