Sub re_dezigne()

fr = InputBox("Номер первой строки с данными...")
levCount = InputBox("Количество уровней в иерархии...")

Application.ScreenUpdating = False

lr = Cells(Rows.Count, 2).End(xlUp).Row

For i = lr To fr Step -1
    If Cells(i, 2) = "" Then
        Rows(i).Delete
    End If
Next i

lr = Cells(Rows.Count, 2).End(xlUp).Row

Columns(1).Delete

For i = levCount To 1 Step -1
    Columns(1).Insert Shift:=xlToRight
Next i

    k = 1
    For i2 = fr To lr
        If Cells(i2, 5).Font.Bold = True Then
            Select Case k
                Case Is = 1
                    lev1 = Cells(i2, 5)
                Case Is = 2
                    lev2 = Cells(i2, 5)
                Case Is = 3
                    lev3 = Cells(i2, 5)
            End Select
            k = k + 1
        Else
            Cells(i2, 4) = Cells(i2, 5)
            Select Case k
                Case Is = 4
                    Cells(i2, 1) = lev1
                    Cells(i2, 2) = lev2
                    Cells(i2, 3) = lev3
                Case Is = 3
                    Cells(i2, 2) = lev2
                    Cells(i2, 3) = lev3
                Case Is = 2
                    Cells(i2, 3) = lev3
            End Select
            If Cells(i2 + 1, 5).Font.Bold = True Then
                k = 3
                If Cells(i2 + 2, 5).Font.Bold = True Then
                    k = 2
                    If Cells(i2 + 3, 5).Font.Bold = True Then
                        k = 1
                    End If
                End If
            End If
        End If
    Next i2
    
For i = lr To fr Step -1
    If Cells(i, 1) = "" Then
        Rows(i).Delete
    End If
Next i
    
Application.ScreenUpdating = True

End Sub