Sub test()
ligne = 2
col = 4
For n = 2 To Range("A" & Rows.Count).End(xlUp).Row
pas = 0.5
If Cells(n, 2) = "" Then
Cells(n, 1).Copy Destination:=Cells(ligne, col)
ligne = ligne + 1
Else
While pas < Cells(n, 2) + 0.5
Cells(n, 1).Copy Destination:=Cells(ligne, col)
Cells(ligne, col) = Cells(ligne, col) & pas
ligne = ligne + 1
pas = pas + 0.5
Wend
End If
Next
End Sub