Sub TableToList()
If ActiveCell.CurrentRegion.Rows.Count < 2 Then
Exit Sub
End If
If ActiveCell.CurrentRegion.Columns.Count < 2 Then
Exit Sub
End If
Dim table As Range: Dim rngColHead As Range
Dim rngRowHead As Range: Dim rngData As Range
Dim rngCurrCell As Range: Dim rowVal As Variant
Dim colVal As Variant: Dim val As Variant
Set table = ActiveCell.CurrentRegion
Set rngColHead = table.Rows(1)
Set rngRowHead = table.Columns(1)
Set rngData = table.Offset(1, 1)
Set rngData = rngData.Resize(rngData.Rows.Count - 1, rngData.Columns.Count - 1)
ActiveWorkbook.Worksheets.Add
ActiveCell.Value = "Row#"
ActiveCell.Offset(0, 1).Value = "RowValue"
ActiveCell.Offset(0, 2).Value = "ColValue"
ActiveCell.Offset(0, 3).Value = "Data"
ActiveCell.Offset(1, 0).Select
Dim n As Long
For Each rngCurrCell In rngData
colVal = rngColHead.Cells(rngCurrCell.Column - table.Column + 1)
rowVal = rngRowHead.Cells(rngCurrCell.Row - table.Row + 1)
n = n + 1
ActiveCell.Value = n
ActiveCell.Offset(0, 1).Value = rowVal
ActiveCell.Offset(0, 2).Value = colVal
ActiveCell.Offset(0, 3).Value = rngCurrCell.Value
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 3).Value = "=" & rngCurrCell.Worksheet.Name & "!" & rngCurrCell.Address
Next
End Sub