Flat bom to multilevel bom

Give this a try. It will clear Sheet2 and create the multi-level structure there.

Option Explicit
Dim s1Row As Long, s1Col As Long, s1End As Long
Dim s2 As Worksheet, s2Row As Long, s2Col As Long, s2PartFnd As Range

Sub BuildPartLevels()
    Sheets("Sheet1").Select
    Set s2 = Sheets("Sheet2")
    s1Row = 2
    s2Row = 2

    With s2
        .Cells.ClearContents
        .Cells.HorizontalAlignment = xlLeft

        ' Get top levels first
        Do Until Cells(s1Row, 3).Value = ""
            If Cells(s1Row, 3).Value = "END ITEM" Then
                .Cells(s2Row, 1).Value = Cells(s1Row, 1).Value ' Part num
                .Cells(s2Row, 2).Value = Cells(s1Row, 2).Value ' Desc
                .Cells(s2Row, 3).Value = Cells(s1Row, 4).Value ' Qty
                .Cells(s2Row, 3).HorizontalAlignment = xlRight
                s2Row = s2Row + 1
            End If
            s1Row = s1Row + 1
        Loop
        If s2Row = 2 Then
            MsgBox "Top level items not found"
            Exit Sub
        End If
        s1End = s1Row - 1
    
        ' Start on sub-levels
        s1Row = 2
        s1Col = 3
        Do Until s1Row > s1End ' Loop through assembly column sets
            Do Until s1Row > s1End ' Loop through rows
                If Cells(s1Row, s1Col).Value <> "END ITEM" And Cells(s1Row, s1Col).Value <> "" Then
                    Set s2PartFnd = .Range("A1")
                    Set s2PartFnd = .Cells.Find(What:=Cells(s1Row, s1Col).Value, After:=s2PartFnd, LookAt:=xlWhole)
                    If s2PartFnd Is Nothing Then
                        MsgBox Cells(s1Row, s1Col).Value & " not found in " & .Name & ". Continuing."
                    Else
FoundPart:
                        s2Row = s2PartFnd.Row + 1
                        s2Col = s2PartFnd.Column + 1
                        .Rows(s2Row).Insert
                        .Rows(s2Row).HorizontalAlignment = xlLeft
                        .Cells(s2Row, s2Col).Value = Cells(s1Row, 1).Value
                        .Cells(s2Row, s2Col + 1).Value = Cells(s1Row, 2).Value
                        .Cells(s2Row, s2Col + 2).Value = Cells(s1Row, s1Col + 1).Value
                        .Cells(s2Row, s2Col + 2).HorizontalAlignment = xlRight

                        Set s2PartFnd = .Cells.Find(What:=Cells(s1Row, s1Col).Value, After:=s2PartFnd, LookAt:=xlWhole)
                        If s2PartFnd.Row > s2Row Then ' the part appears in more than one higher level
                            GoTo FoundPart
                        End If
                    End If
                End If
                s1Row = s1Row + 1
            Loop
            s1Row = 2
            s1Col = s1Col + 2 ' Next assembly column
            If Cells(s1Row, s1Col).Value = "" Then ' Find first part in the next assembly column
                s1Row = Cells(s1Row, s1Col).End(xlDown).Row
            End If
        Loop
        .Columns("A:" & Left(.Cells.SpecialCells(xlCellTypeLastCell).Address(, False), 1)).ColumnWidth = 15
        .Select
    End With
End Sub