XL 2010 Trouver les différences dans un tableau

Option Explicit

Sub ShowDiff()
  If ActiveSheet.Name <> "Différence" Then Exit Sub
  Dim m&, n1&, n2&, n3&: m = Rows.Count
  Dim sh1 As Worksheet: Set sh1 = Worksheets("Ancien")
  n1 = sh1.Cells(m, 1).End(3).Row: If n1 = 1 Then Exit Sub
  Dim sh2 As Worksheet: Set sh2 = Worksheets("Nouveau")
  n2 = sh2.Cells(m, 1).End(3).Row: If n1 = 1 Then Exit Sub
  Dim D(1 To 15), P1&, G1$, P2&, G2$, i&, j%, k As Byte
  n3 = Cells(m, 1).End(3).Row: Application.ScreenUpdating = 0
  If n3 > 3 Then
    With Range("A4:O" & n3)
      .Interior.ColorIndex = -4142: .ClearContents
    End With
  End If
  n3 = 4
  For i = 2 To n1
    P1 = sh1.Cells(i, 1): G1 = sh1.Cells(i, 2)
    P2 = sh2.Cells(i, 1): G2 = sh2.Cells(i, 2)
    If (P1 = P2) Or (G1 = G2) Then
      Erase D: k = 0
      For j = 1 To 15
        If sh1.Cells(i, j) <> sh2.Cells(i, j) Then
          D(j) = 1: k = k + 1
        End If
      Next j
      If k > 0 Then
        sh2.Cells(i, 1).Resize(, 15).Copy Cells(n3, 1)
        For j = 1 To 15
          If D(j) = 1 Then Cells(n3, j).Interior.Color = 255
        Next j
        n3 = n3 + 1
      End If
    End If
  Next i
End Sub