Private Sub Worksheet_Activate()
Dim critere, ub%, d As Object, e, resu(), w As Worksheet, tablo, i&, copie As Boolean, j%, n&, nn&
critere = Feuil1.[B4:F4] 'vecteur ligne, plus rapide
ub = UBound(critere, 2)
Set d = CreateObject("Scripting.Dictionary")
'---liste des éléments de critère sans doublon---
For Each e In critere: d(e) = "": Next e
'---tableau des résultats---
ReDim resu(1 To Rows.Count, 1 To ub + 4)
For Each w In Worksheets
If w.Name <> Me.Name Then
tablo = w.Range("A6").CurrentRegion.Resize(, ub + 2) 'matrice, plus rapide
For i = 1 To UBound(tablo)
copie = True
For j = 1 To ub
If Not d.exists(tablo(i, j + 1)) Then copie = False: Exit For
Next j
If copie Then
n = n + 1 'comptage global
resu(n, 1) = tablo(i, 1)
For j = 1 To ub
resu(n, j + 1) = tablo(i, j + 1)
If resu(n, j + 1) <> critere(1, j) Then copie = False
Next j
If copie Then nn = nn + 1 'comptage dans l'ordre
resu(n, ub + 2) = tablo(i, ub + 2)
resu(n, ub + 3) = w.Name
resu(n, ub + 4) = "dans " & IIf(copie, "l'ordre", "le désordre")
End If
Next i
End If
Next w
'---restitution---
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A7] '1ère cellule de validation, à adapter
Intersect(.CurrentRegion, Rows(.Row).Resize(Rows.Count - .Row + 1)).ClearContents 'RAZ
If n Then .Resize(n, ub + 4) = resu
End With
With UsedRange: End With 'ajuste les barres de défilement
Application.ScreenUpdating = True
MsgBox n & " ligne(s) trouvée(s) dont " & nn & " dans l'ordre et " & n - nn & " dans le désordre", vbInformation, "Recherche"
End Sub