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