Sub remplir()
Dim last, T(), i
last = Range("a" & Rows.Count).End(xlUp).Row
ReDim T(1 To 2, 0 To 0)
T(1, 0) = 1
For i = 2 To last
If Cells(i, 1).Value <> "" Then
ReDim Preserve T(1 To 2, 0 To 1 + UBound(T, 2))
T(1, UBound(T, 2)) = i + 1
T(2, UBound(T, 2)) = Cells(i, 1).Value
End If
Next i
For i = 1 To UBound(T, 2)
Range(Cells(T(1, i - 1) + 1, "a"), Cells(T(1, i), "a")) = T(2, i)
Next i
End Sub