convert this table into a list

With this 2 macor's.

See the attched file.

I made headers in the sheet, for a working macro.

I also renamed your sheetname in sheet1

Sub CONVERTROWSTOCOL_Oeldere_revisted()

Dim rsht1 As Long, rsht2 As Long, i As Long, col As Long, wsTest As Worksheet

'check if sheet "ouput" already exist

Const strSheetName As String = "Output"
 
Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
 
If wsTest Is Nothing Then
    Worksheets.Add.Name = strSheetName
End If

   
   With Sheets("Output")
    .UsedRange.ClearContents
    .Range("A1:D1").Value = Array("Number", "Project", "Value", "Column")

    End With
    
    
    rsht1 = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row
    rsht2 = Sheets("Output").Range("A" & Rows.Count).End(xlUp).Row
    col = 3
    
    For i = 2 To rsht1
            Do While Sheets("sheet1").Cells(1, col).Value <> ""
            rsht2 = rsht2 + 1
           
            Sheets("Output").Range("A" & rsht2).Value = Sheets("sheet1").Range("A" & i).Value
            
            Sheets("Output").Range("B" & rsht2).Value = Sheets("sheet1").Range("B" & i).Value
           
            Sheets("Output").Range("D" & rsht2).Value = Sheets("sheet1").Cells(1, col).Value
            
            Sheets("Output").Range("C" & rsht2).Value = Sheets("sheet1").Cells(i, col).Value
            
            
     
            col = col + 1
        Loop
        col = 3
    Next
  With Sheets("Output")

   Columns("A:Z").EntireColumn.AutoFit
    End With
End Sub

Sub Delete_empty_rows_Column_C()

With Columns("C").SpecialCells(xlCellTypeBlanks).Cells
    .EntireRow.Delete Shift:=xlUp
  End With
  If Err.Number <> 0 Then MsgBox "There are no empty cells"
 End Sub

Hi,

Check the attached macro, see if it helps :examble.xlsm