Dim rng As Range
    Dim cel As Range
    Dim intI As Integer
    
    Set rng = Worksheets("Лист1").Range("A:A")

    intI =  0 
    For Each cel In rng
        If (IsEmpty(cel.Value)) Then
            intI = intI +  1 
            If intI =  4  Then
                If Not (IsEmpty(cel.Offset( 2 ,  0 ))) Then
                    Worksheets("Лист1").Range("" & cel.Address & "," _
                      & cel.Offset(- 1 ,  0 ).Address & "," _
                      & cel.Offset(- 2 ,  0 ).Address & "," _
                      & cel.Offset(- 3 ,  0 ).Address & "").Delete Shift:=xlUp
                      intI =  0 
                End If
            ElseIf intI >  4  Then
                Exit For
            End If
        End If
    Next cel