Sub Changés()
Application.ScreenUpdating = False
Set f1 = Sheets("ancien")
Set f2 = Sheets("nouveau")
Set f3 = Sheets("changés")
f3.[A2:O1000].ClearContents
f3.[A2:O1000].Interior.ColorIndex = xlNone
a = f1.Range("A1").CurrentRegion.Value
b = f2.Range("A1").CurrentRegion.Value
Set MonDico1 = CreateObject("Scripting.Dictionary")
Set MonDico2 = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(a)
temp = ""
For k = 1 To UBound(a, 2): temp = temp & a(i, k): Next k
MonDico1(temp) = ""
MonDico2(a(i, 1)) = ""
Next i
ligne = 2
For i = 2 To UBound(b)
temp = ""
For k = 1 To UBound(b, 2): temp = temp & b(i, k): Next k
If MonDico2.exists(b(i, 1)) And Not MonDico1.exists(temp) Then
Set temp = f1.Columns(1).Find(b(i, 1))
For k = 1 To UBound(b, 2)
f3.Cells(ligne, k) = b(i, k)
If b(i, k) <> temp.Offset(, k - 1) Then f3.Cells(ligne, k).Interior.ColorIndex = 6
Next k
f3.Cells(ligne, k) = i
ligne = ligne + 1
End If
Next
End Sub