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