Sub es()
Dim t As Variant, t2(), m As Object, x As Long, i As Long, k As Long, c As Range
On Error Resume Next
Application.ScreenUpdating = False
With Sheets("Feuil2")
Set c = .Range("a6:j" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
c.Copy Destination:=Sheets("tdb base").Range("a" & Rows.Count).End(xlUp)(2)
Set m = CreateObject("Scripting.Dictionary")
t = Range("a6:j" & Cells(Rows.Count, 1).End(xlUp).Row)
x = 1
For i = 1 To UBound(t)
If Not m.Exists(t(i, 1)) Then
m.Add t(i, 1), t(i, 1)
ReDim Preserve t2(1 To 10, 1 To x)
For k = 1 To 10: t2(k, x) = t(i, k)
Next k: x = x + 1: End If: Next i
Range("a6:j" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
Range("a6").Resize(UBound(t2, 2), UBound(t2, 1)) = Application.Transpose(t2)
Erase t, t2: Set m = Nothing
End Sub