Удалить лишние пустые строки

[vfv]

Подскажите как начиная с 8 строки на этом листе сделать макросом между заполненными строками только
по одной пустой как на Лист2
Пример во вложении.

[The_Prist]

Вот весь макрос:

Sub Del_Rows()
    Dim li As Long
    Application.ScreenUpdating = False
    For li = Cells(Rows.Count, 1).End(xlUp).Row To 8 Step -1
        If Rows(li).Text = "" And Rows(li + 1).Text = "" Then Rows(li + 1).Delete
    Next li
    Application.ScreenUpdating = True
End Sub

[vfv]

Спасибо вам The_Prist!
Макрос работает на все 100.