Option Explicit

Sub myReport()
    Dim arr As Variant
    arr = GetFromSheet(Sheets(1))
    PrintArr arr
End Sub

Private Function GetFromSheet(sh As Worksheet) As Variant
    With sh
        Dim arr As Variant
        arr = .Range(.Cells(1, 1), .Cells(.UsedRange.Row + sh.UsedRange.Rows.Count - 1, .UsedRange.Column + sh.UsedRange.Columns.Count - 1)).Value
        
        Dim brr As Variant
        ReDim brr(1 To UBound(arr, 1), 1 To 16)
        
        Dim sName As String
        Dim yb As Long
        Dim ys As Long
        For ys = sh.UsedRange.Row To sh.UsedRange.Row + sh.UsedRange.Rows.Count - 1
            Select Case sh.Cells(ys, 1).IndentLevel
            Case 1
                sName = arr(ys, 1)
            Case 4
                yb = yb + 1
                brr(yb, 2) = arr(ys, 1)
                brr(yb, 3) = sName
                brr(yb, 11) = arr(ys, 5)
                brr(yb, 12) = arr(ys, 6)
                brr(yb, 16) = arr(ys, 10)
            End Select
        Next
    End With
    GetFromSheet = brr
End Function

Private Sub PrintArr(arr As Variant)
    With Workbooks.Add(1)
        With .Worksheets(1)
            With .Cells(3, 1).Resize(UBound(arr, 1), UBound(arr, 2))
                .Value = arr
            End With
        End With
    End With
End Sub

Option Explicit
'v2
Sub myReport()
    CloseEmptyWb
    Dim arr As Variant
    arr = GetFromSheet(ActiveSheet)
    If Not IsEmpty(arr) Then PrintArr arr
End Sub

Private Function GetFromSheet(sh As Worksheet) As Variant
    With sh
        Dim arr As Variant
        arr = .Range(.Cells(1, 1), .Cells(.UsedRange.Row + sh.UsedRange.Rows.Count - 1, .UsedRange.Column + sh.UsedRange.Columns.Count - 1)).Value
        
        Dim brr As Variant
        ReDim brr(1 To UBound(arr, 1), 1 To 17)
                
        Dim crr As Variant
        ReDim crr(1 To 10)
                
        Dim xb As Long
        Dim yb As Long
        Dim ys As Long
        For ys = sh.UsedRange.Row To sh.UsedRange.Row + sh.UsedRange.Rows.Count - 1
            Select Case sh.Cells(ys, 1).IndentLevel
            Case 0
                crr(7) = arr(ys, 1)
            Case 1
                crr(3) = arr(ys, 1)
            Case 2
                crr(1) = arr(ys, 1)
                crr(4) = arr(ys, 4)
                crr(5) = arr(ys, 3)
                crr(6) = arr(ys, 2)
            Case 3
                crr(8) = arr(ys, 1)
                crr(9) = arr(ys, 2)
                crr(10) = arr(ys, 3)
            Case 4
                yb = yb + 1
                
                For xb = 1 To UBound(crr)
                    brr(yb, xb) = crr(xb)
                Next
                
                brr(yb, 2) = arr(ys, 1)
                brr(yb, 11) = arr(ys, 5)
                
                For xb = 12 To 17
                    brr(yb, xb) = arr(ys, xb - 6)
                Next
            End Select
        Next
    End With
    If yb > 0 Then
        ResizeArray brr, yb
        GetFromSheet = brr
    End If
End Function

Private Sub ResizeArray(arr As Variant, nn As Long)
    If nn <= 0 Then Exit Sub
    If nn = UBound(arr, 2) Then Exit Sub
    Dim brr As Variant
    ReDim brr(1 To nn, 1 To UBound(arr, 2))
    
    Dim yb As Long
    Dim xb As Long
    For yb = 1 To UBound(brr, 1)
        For xb = 1 To UBound(brr, 2)
            brr(yb, xb) = arr(yb, xb)
        Next
    Next
    arr = brr
End Sub

Private Sub PrintArr(arr As Variant)
    With Workbooks.Add(1)
        With .Worksheets(1)
            With .Cells(2, 1).Resize(UBound(arr, 1), UBound(arr, 2))
                .Columns(2).NumberFormat = "@"
                .Value = arr
                
                .Columns(1).ColumnWidth = 29
                .Columns(2).ColumnWidth = 10
                .Columns(3).ColumnWidth = 19
                .Columns(4).ColumnWidth = 19
                .Columns(5).ColumnWidth = 19
                .Columns(6).ColumnWidth = 19
                .Columns(7).ColumnWidth = 20
                .Columns(8).ColumnWidth = 34
                .Columns(9).ColumnWidth = 46
                .Columns(10).ColumnWidth = 19
                .Columns(11).ColumnWidth = 8
                .Columns(12).ColumnWidth = 18
                .Columns(13).ColumnWidth = 18
                .Columns(14).ColumnWidth = 18
                .Columns(15).ColumnWidth = 18
                .Columns(16).ColumnWidth = 18
                .Columns(17).ColumnWidth = 18

            End With
        End With
    End With
End Sub

Private Sub CloseEmptyWb()
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        If wb.Path = "" Then wb.Close False
    Next
End Sub