Sub Maj()
Dim Dossards() As Variant
TabDossards = Range("A3:F48").Value
For i = LBound(TabDossards, 1) To UBound(TabDossards, 1)
NumDossard = TabDossards(i, 1)
If NumDossard <> "" And Not (NumDossard Like "Dossard*") Then
With Sheets("Listing As")
Set trouve = .Range("TabListing").Find(NumDossard, LookIn:=xlValues, lookat:=xlWhole)
If Not trouve Is Nothing Then
TabDossards(i, 2) = trouve.Offset(0, -5)
TabDossards(i, 3) = trouve.Offset(0, -4)
TabDossards(i, 4) = trouve.Offset(0, -2)
TabDossards(i, 5) = trouve.Offset(0, -3)
TabDossards(i, 6) = trouve.Offset(0, -1)
End If
End With
End If
Next i
Range("A3").Resize(UBound(TabDossards, 1), UBound(TabDossards, 2)) = TabDossards
End Sub