Macro for extracting data from a long column and insert it in its own column with a header

Hi Anders,
try

Sub ertert()
Dim x, y(), i&, j&, k&
x = Sheets("Sheet1").Range("A1").CurrentRegion.Value
ReDim y(1 To UBound(x), 1 To 4): j = 1: k = 1
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 2 To UBound(x)
        If .Exists(x(i, 1)) Then
            j = .Item(x(i, 1)) '#row
        Else
            j = j + 1: .Item(x(i, 1)) = j
            y(j, 1) = x(i, 1)
        End If
        If .Exists(x(i, 3)) Then
            k = .Item(x(i, 3)) '#column
        Else
            k = k + 1: .Item(x(i, 3)) = k
            If k > UBound(y, 2) Then ReDim Preserve y(1 To UBound(y), 1 To k)
            y(1, k) = x(i, 3)
        End If
        y(j, k) = x(i, 2)
    Next i
End With
y(1, 1) = "Data"
With Sheets("Sheet2")
    .Range("A1").CurrentRegion.ClearContents
    .Range("A1").Resize(j, k).Value = y()
    .Activate
End With
End Sub