Private f As Boolean

Sub X()
    Dim rng As Range
    
    Set rng = Worksheets("Лист1").Range("A1").CurrentRegion
    Set rng = rng.Offset( 1 ,  0 ).Resize _
      (rng.Rows.Count -  1 , rng.Columns.Count)
    
    For Each rng In rng.Columns( 3 ).Cells
        f = False
        Y rng,  0 ,  1 
    Next rng
End Sub

Sub Y( _
  ByVal rng As Range, _
  ByRef lngOffset1 As Long, _
  ByRef lngOffset2 As Long)
    Dim dbl As Double

    If IsEmpty(rng.Offset( 0 , lngOffset2)) Then Exit Sub

    dbl = rng.Offset( 0 , lngOffset1) - rng.Offset( 0 , lngOffset2)
    rng.Offset( 0 , lngOffset2) = dbl
    
    If dbl >=  0  Then
        lngOffset2 = lngOffset2 +  3 
        
        If Not f Then
            f = True
            lngOffset1 = lngOffset1 +  1 
        Else
            lngOffset1 = lngOffset1 +  3 
        End If
        
        Y rng, lngOffset1, lngOffset2
    End If
End Sub