Sub Toto()
Dim rg1 As Range, rg2 As Range
Dim ar1(1 To 8, 1 To 8), ar2
Dim i As Integer, j As Integer
Set rg1 = Sheets("Feuil5").Range("B14") 'matrice
Set rg2 = Sheets("Atelier 1").Range("A15:I63") 'tableau
ar2 = rg2.Value
For i = 2 To UBound(ar2, 1) - 1
If ar2(i, 1) <> "" Then
j = Application.Match(ar2(i, 8), Array("A", "B", "C", "D", "E", "F", "G", "H"))
If ar1(j, ar2(i, 9)) = "" Then
ar1(j, ar2(i, 9)) = ar2(i, 1)
Else
ar1(j, ar2(i, 9)) = ar1(j, ar2(i, 9)) & vbLf & ar2(i, 1)
End If
End If
Next i
rg1.Resize(8, 8) = ar1
End Sub