Sub toto()
Dim i&, j&, t(), RF(), RD(), RFD As New Scripting.Dictionary, Plg As Range '
RF = [RFac].Value 'plage de données =Feuil1!$A$2:$C$5
RD = [RDéc].Value 'plage de données =Feuil1!$D$2:$H$7
With RFD '
For i = 2 To UBound(RF) '
If Not IsEmpty(RF(i, 1)) Then If Not .Exists(RF(i, 1)) Then .Add RF(i, 1), Array(RF(i, 2), RF(i, 3), Empty, Empty, "X", Empty) '
Next '
For i = 2 To UBound(RD) '
If Not IsEmpty(RD(i, 1)) Then '
If .Exists(RD(i, 1)) Then '
.Item(RD(i, 1)) = Array(RD(i, 2), RD(i, 3), RD(i, 4), RD(i, 5), "X", "X") '
Else '
.Add RD(i, 1), Array(RD(i, 2), RD(i, 3), RD(i, 4), RD(i, 5), Empty, "X") '
End If '
End If '
Next '
ReDim t(.Count + (.Count <> 0), -1 To 5) '
For i = 0 To .Count - 1: t(i, -1) = .Keys(i): For j = 0 To 5: t(i, j) = .Items(i)(j): Next j, i '
End With '
Set Plg = Feuil2.[A2].Resize(i - (i = 0), 7) 'plage de résultats
Plg.CurrentRegion.Offset(1).ClearContents
Plg.Value = t '
With Plg.Parent '
With .Sort '
.SortFields.Clear '
.SortFields.Add Key:=Plg(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal '
.SetRange Plg '
.Header = xlNo '
.MatchCase = False '
.Orientation = xlTopToBottom '
.SortMethod = xlPinYin '
.Apply '
End With '
.Activate '
End With '
Plg(1).Offset(-1).Select 'Facultatif
End Sub