rapprochement de 2 fichiers excel

Dim P1 As Range, P2 As Range, tablo(), d As Object, n& 'mémorise

Private Sub Worksheet_Activate()
Dim F1 As Worksheet, t1, F2 As Worksheet, t2
Set F1 = Feuil1 'CodeName
Set P1 = F1.Range("A3", F1.Range("A" & F1.Rows.Count).End(xlUp)(4))
t1 = P1 'matrice, plus rapide
Set F2 = Feuil2 'CodeName
Set P2 = F2.Range("A3", F2.Range("A" & F2.Rows.Count).End(xlUp)(4))
t2 = P2 'matrice, plus rapide
ReDim tablo(1 To UBound(t1) + UBound(t2), 1 To 3)
Set d = CreateObject("Scripting.dictionary")
n = 0
Remplissage t1
Remplissage t2
'---restitution---
If n Then
  [A2].Resize(n, 3) = tablo
  [A2].Resize(n, 3).Sort [A2], xlAscending, Header:=xlNo 'tri
End If
Range("A" & n + 2 & ":C" & Rows.Count).ClearContents
End Sub

Sub Remplissage(tb)
Dim t, m1#, m2#
For Each t In tb
  If Not d.exists(t) Then
    d(t) = ""
    m1 = Application.SumIf(P1, t, P1.Offset(, 1))
    m2 = Application.SumIf(P2, t, P2.Offset(, 1))
    If m1 <> m2 Then
      n = n + 1
      tablo(n, 1) = t
      tablo(n, 2) = m1 'IIf(m1, m1, "n/a")
      tablo(n, 3) = m2 'IIf(m2, m2, "n/a")
    End If
  End If
Next
End Sub

Dim tablo() 'mémorise

Private Sub Worksheet_Activate()
Dim F1 As Worksheet, F2 As Worksheet, lig&, t1, t2, n&
Set F1 = Feuil1 'CodeName
Set F2 = Feuil2 'CodeName
lig = 3 '1ère ligne étudiée
t1 = F1.Cells(lig, 1).Resize(F1.Cells(F1.Rows.Count, 1).End(xlUp).Row, 2)
t2 = F2.Cells(lig, 1).Resize(F2.Cells(F2.Rows.Count, 1).End(xlUp).Row, 2)
n = UBound(t1) + UBound(t2)
ReDim tablo(1 To n, 1 To 5)
Remplissage t1, t2, 0, UBound(t1), lig, 3
Remplissage t2, t1, UBound(t1), 0, lig, 4
'---restitution---
[A2].Resize(n, 4) = tablo
[A2].Resize(n, 4).Sort [A2], xlAscending, Header:=xlNo 'tri indispensable
Range("A" & n + 2 & ":D" & Rows.Count).ClearContents
n = Me.UsedRange.Rows.Count 'ajustement de la barre de défilement verticale
End Sub

Sub Remplissage(t1, t2, decal1&, decal2&, lig&, col As Byte)
Dim fin&, i&, x$, j&
fin = UBound(t2)
For i = 1 To UBound(t1)
  If IsEmpty(tablo(i + decal1, 5)) Then
    x = t1(i, 1) & Chr(1) & t1(i, 2)
    For j = 1 To fin
      If IsEmpty(tablo(j + decal2, 5)) Then
        If x = t2(j, 1) & Chr(1) & t2(j, 2) Then
          tablo(i + decal1, 5) = 1
          tablo(j + decal2, 5) = 1
          GoTo 1
        End If
      End If
    Next
    tablo(i + decal1, 1) = t1(i, 1)
    tablo(i + decal1, 2) = t1(i, 2)
    tablo(i + decal1, col) = lig + i - 1
  End If
1 Next
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row = 1 Or Target.Row > Range("A" & Rows.Count).End(xlUp).Row Then Exit Sub
Cancel = True
With Cells(Target.Row, 3)
  If .Value Then
    Application.Goto Feuil1.Cells(.Value, 1), True
  Else
    Application.Goto Feuil2.Cells(.Offset(, 1), 1), True
  End If
End With
End Sub