Sub Bouton1_Clic()
Application.ScreenUpdating = False
Range("B2:B" & Range("A65535").End(xlUp).Row).Select
Selection.Delete Shift:=xlUp
[A1].Select
For i = 2 To 36 ' à adapter
For Each cellule In Range("D2:J19") ' à adapter
If cellule = Cells(i, 1) And Cells(i, 2) = "" Then Cells(cellule.Row, 3).Copy Destination:=Cells(i, 2)
Next cellule
Next i
Application.ScreenUpdating = True
End Sub