Sub SEPARE()
Dim r As Range, t, i&
Set r = Range("D1:D2" & [D65536].End(xlUp).Row) 'au moins 2 cellules
t = r 'tableau, plus rapide
For i = 2 To UBound(t)
t(i, 1) = IIf(Val(r(i).Text), Val(r(i).Text), "")
Next
With [E1].Resize(UBound(t))
.Value = t
'.SpecialCells(xlCellTypeBlanks).Delete xlUp 'supprime les cellules vides
End With
End Sub