Sub toto()
Dim i&, j&, k&, l&, n&, pn, ut, v(), Dat()
'Paramètres :
Dim Dat1$, Dat2$, Dat3$
Const NL1& = 3001 'Nombre maximum de lignes à prendre en compte dans la 1ère feuille de données. ( > 0 et <= Rows.Count )
Const NL2& = 5001 'Nombre maximum de lignes à prendre en compte dans la 2ème feuille de données. ( > 0 et <= Rows.Count )
Const NC2& = 4 'Nombre de colonnes à prendre en compte dans la 2ème feuille de données. ( > 0 et <= Columns.Count-1 )
Const VN$ = "A619_PP_ROGER2327" 'Chaîne de caractères arbitraire acceptable par le gestionnaire de noms mais étrangère à son contenu.
Dat1$ = "'" & Feuille01.Name & "'" '1ère feuille de données.
Dat2$ = "'" & Feuille02.Name & "'" '2ème feuille de données.
Dat3$ = Feuille03.Name 'feuille de synthèse.
'
On Error Resume Next
i = Names(VN).Index: If Err.Number = 0 Then MsgBox "Modifiez la constante VN !": End
On Error GoTo 0
v = Array(Array(Dat1, NL1, 2), Array(Dat2, NL2, NC2))
ReDim Dat(UBound(v))
For i = 0 To UBound(v)
Names.Add Name:=VN, RefersToR1C1:="=OFFSET(" & v(i)(0) & "!R1C1,,,MAX((" & v(i)(0) & "!R1C1:R" & v(i)(1) & "C1<>"""")*ROW(" & v(i)(0) & "!R1:R" & v(i)(1) & "),1)," & v(i)(2) & ")"
Dat(i) = Range(VN).Value
Next
Names(VN).Delete
l = UBound(Dat(1))
For i = 1 To UBound(Dat(0)): For j = 1 To l
If Dat(0)(i, 2) = Dat(1)(j, 1) Then n = n + 1
Next j, i
n = n - (n = 0)
ReDim v(1 To n, NC2)
n = 0
For i = 1 To UBound(Dat(0))
pn = Dat(0)(i, 1)
If Not IsEmpty(pn) Then
ut = Dat(0)(i, 2)
For j = 1 To l
If ut = Dat(1)(j, 1) Then n = n + 1: v(n, 0) = pn: v(n, 1) = ut: For k = 2 To NC2: v(n, k) = Dat(1)(j, k): Next
Next
End If
Next
k = (Rows.Count + n - Abs(Rows.Count - n)) / 2
With Worksheets(Dat3).[A1]
.CurrentRegion.ClearContents
.Resize(k - (k = 0), NC2 + 1).Value = v
End With
If n > k Then MsgBox n - Rows.Count & " ligne" & IIf(n - Rows.Count > 1, "s n'ont pu être affichées.", " n'a pu être affichée.")
End Sub