Excel formula to transfer values into new table with their types as column headers

SourcePilot 

You may try the following macro to transform the data into the desired format.

In the attached, click the button called "Transform Data" on Sheet1 to run the code.

Sub TransformData()
Dim wsData As Worksheet, wsOutupt As Worksheet
Dim x, y(), dict, it
Dim i As Long, j As Long
Dim c

Application.ScreenUpdating = False

Set wsData = Worksheets("Sheet1")       'Data Sheet

On Error Resume Next
Set wsOutupt = Worksheets("Output")     'Transformed data will be placed on this sheet
wsOutupt.Cells.Clear
On Error GoTo 0

If wsOutupt Is Nothing Then
    Set wsOutupt = Worksheets.Add(after:=wsData)
    wsOutupt.Name = "Output"            'Transformed data will be placed on this sheet
End If

x = wsData.Range("A1").CurrentRegion.value
Set dict = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(x, 1)
    For j = 1 To UBound(x, 2)
        If InStr(x(i, j), ":") > 0 Then
            dict.Item(x(i, j)) = ""
        End If
    Next j
Next i

If dict.Count = 0 Then
    MsgBox "Data not in desired format!", vbExclamation
    Exit Sub
End If

ReDim y(1 To UBound(x, 1) + 1, 1 To dict.Count)

j = 0

For Each it In dict.keys
    j = j + 1
    y(1, j) = it
Next it

For i = 1 To UBound(x, 1)
    For j = 1 To UBound(x, 2)
        If InStr(x(i, j), ":") > 0 Then
            c = Application.Match(x(i, j), Application.Index(y, 1, 0), 0)
            If Not IsError(c) Then
                y(i + 1, c) = x(i, j + 1)
            End If
        End If
    Next j
Next i

wsOutupt.Range("A1").Resize(UBound(y, 1), UBound(y, 2)).value = y

With wsOutupt.Rows(1)
    .Replace ":", ""
    .Font.Bold = True
    .Font.Size = 12
End With

With wsOutupt.Range("A1").CurrentRegion
    .Columns.AutoFit
    .Borders.Color = vbBlack
End With

wsOutupt.Select

Application.ScreenUpdating = True
End Sub