Hier mal eine vollständige Version für dein Vorhaben. Vorrausetzung du hast den ersten Wert als aktive Zelle markiert
Mangels Beispieldaten ist das ungetestet.
Sub umsortieren()
Dim rngA As Range
Dim arrtmp, i As Long, cnt As Long
Set rngA = ActiveCell
arrtmp = rngA.CurrentRegion
rngA.CurrentRegion.Clear
cnt = rngA.Row
For i = LBound(arrtmp) To UBound(arrtmp)
If arrtmp(i, 1) <> "" Then
rngA.Offset(cnt, 1).Value = arrtmp(i, 1)
cnt = cnt + 1
Else
Set rngA = rngA.Offset(, 1)
cnt = rngA.Row
End If
Next
End Sub