Option Explicit
Sub Essai()
Dim nom$, i As Byte, j As Byte, k As Byte
Application.ScreenUpdating = 0: [B16:F18].ClearContents
For i = 16 To 18
nom = Cells(i, 1): j = 2
For k = 3 To 12
If Cells(k, 2) = nom Then
With Cells(i, j)
.NumberFormat = "000": .Value = Cells(k, 1)
End With
j = j + 1
End If
Next k
Next i
End Sub