Bonjour Kleem,
Comme ceci :
Restitution sur une nouvelle feuille
Option Explicit
Sub test()
Dim a, i As Long, dico As Object
Set dico = CreateObject("Scripting.Dictionary")
dico.CompareMode = 1
'2eme feuille dans le classeur
With Sheets(2).Range("a5").CurrentRegion
a = .Value
For i = 1 To UBound(a, 1)
dico(a(i, 1)) = VBA.Array(a(i, 1), a(i, 2), _
a(i, 3), a(i, 4), a(i, 5), a(i, 6), a(i, 7), a(i, 8), a(i, 9))
Next
End With
'1ere feuille dans le classeur
With Sheets(1).Range("a1").CurrentRegion
a = .Value
For i = 2 To UBound(a, 1)
If Not dico.exists(a(i, 1)) Then
dico(a(i, 1)) = VBA.Array(a(i, 1), a(i, 2), _
a(i, 3), a(i, 4), a(i, 5), a(i, 6), a(i, 7), a(i, 8), a(i, 9))
End If
Next
End With
'feuille de restitution
'3eme feuille dans le classeur
With Sheets(3).Range("a1")
.CurrentRegion.Clear
.Resize(dico.Count, 9).Value = _
Application.Transpose(Application.Transpose(dico.items))
End With
Set dico = Nothing
End Sub
klin89