[Spirosgr]

Καλημέρα
Ο κώδικας ολοκληρωμένος, για όσους μας διαβάζουν κι έχουν παρόμοιο θέμα.

Τι κάνει
Αν στη γραμμή 1, το τμήμα d1:m1 είναι κενό, τότε:
1.Ευθυγραμμίζει τις εγγραφές
2.Διαγράφει τις ενδιάμεσες κενές γραμμές
3.Διορθώνει τον α/α

Sub FixData()
    If WorksheetFunction.CountA(Range("d1:m1")) = 0 Then
        ActiveSheet.Range("d1:m1").Delete Shift:=xlUp
    Else
        Exit Sub
    End If

    Dim lrow As Long, i As Long
    lrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

    Application.ScreenUpdating = False

    For i = lrow To 2 Step -2
        ActiveSheet.Rows(i).Delete Shift:=xlUp
        ActiveSheet.Cells(i - 1, 1).Value = (ActiveSheet.Cells(i - 1, 1).Value + 1) / 2
    Next i
End Sub

Προσαρμόστε ανάλογα, με τις ανάγκες σας για διαφορετικό layout...

Αν δεν θέλετε να εκτελείται στο ενεργό φύλλο, αλλά σε κάποιο άλλο,
αντικαταστήστε παντού, το ActiveSheet, με το κωδικό όνομα του φύλλου σας.

*Τα πιο πάνω ισχύουν για το συγκεκριμένο layout του παραδείγματος