Sort table vertically

[Sinlink]

Hello Community,
I have attached an Excel spreadsheet where company data is available.
Not all companies have data in all columns as the 'Before' Sheet shows.
Since I want to further process the sheets, I need a uniform structure of the data.

I would like to name the row by input box or at a designated spot in the Code that shows the order of the companies that I would need.

The goal is to list the company names one below the other, and write the missing ones in the columns without data or with zeros.
As a Result the companies should then be listet uniformly under each other as shown in the sheet 'After' even if the companies then have no data.

The sheets can become very long. I have only attached an excerpt in the Excel sheet.

I am not stuck on this code.
Feel free to change it or discard it.

I am a complete beginner in VBA programming and therefore do not know what is wrong with the code.
I hope you can help me, for which I am very grateful.

Here is the Code:

Sub Company_names_in_Table_Sort_Interpretive()
  Dim a As Range, b As Variant, c As Variant, d As Variant, e As Variant
  Dim i As Long, j As Long, lc As Long, lr As Long, cols As Long, n As Long
  '
  'Fill headings
  lc = ActiveSheet.Cells.Find("*", , xlValues, xlPart, xlByColumns, xlPrevious).Column
  d = Range("A1", Cells(Range("A" & Rows.Count).End(3).Row, lc)).Value2
  For i = 1 To UBound(d, 1)
    If d(i, UBound(d, 2)) <> "" Then
      lr = i
      Exit For
    End If
  Next
  cols = lc - 2
  ReDim e(1 To 1, 1 To cols)
  For i = 1 To cols
    e(1, i) = Cells(lr, i + 2)
  Next
  '
  'Sort columns
  For Each a In Range("C4", Range("C" & Rows.Count).End(3)).SpecialCells(xlCellTypeConstants).Areas
    b = a.Resize(a.Rows.Count, cols).Value
    ReDim c(1 To UBound(b, 1), 1 To UBound(b, 2))
    For j = 1 To UBound(b, 2)
      c(1, j) = e(1, j)
      If b(1, j) <> "" Then
        n = Replace(Split(b(1, j), "(")(1), ")", "")
        For i = 1 To UBound(b, 1)
          c(i, n) = b(i, j)
        Next i
      End If
    Next j
    a.Resize(a.Rows.Count, 7).Value = c
  Next a
  End Sub