Option Compare Text 'la casse est ignorée
Private Sub Worksheet_Activate()
Dim w As Worksheet, base, ub&, t, i&, x, y, z, j&, n&, rest()
base = Sheets("Base").[A1].CurrentRegion.Resize(, 3)
ub = UBound(base)
For Each w In Worksheets
If w.Name <> "Base" And w.Name <> Me.Name Then
t = w.[A1].CurrentRegion.Resize(, 3)
For i = 2 To UBound(t)
x = t(i, 1): y = t(i, 2): z = t(i, 3)
For j = 2 To ub
If base(j, 1) = x And base(j, 2) = y And base(j, 3) = z Then
n = n + 1
ReDim Preserve rest(1 To 4, 1 To n)
rest(1, n) = x: rest(2, n) = y: rest(3, n) = z
rest(4, n) = w.Name
Exit For
End If
Next j
Next i
End If
Next w
If n Then [A2].Resize(n, 4) = Application.Transpose(rest)
Rows(n + 2 & ":" & Rows.Count).Delete
Columns.AutoFit 'ajustement largeur
End Sub