Rijen naar kolommen met unieke waarde als eerste kolom.

Sub hsv()
Dim sv, sq, i As Long, n As Long, j As Long, b As Long
sv = Blad1.Cells(1).CurrentRegion
ReDim a(UBound(sv), UBound(sv))
For i = 2 To UBound(sv)
 a(0, 0) = sv(1, 1)
 If sv(i, 1) <> sq Then j = 0: n = n + 1
                   a(n, 0) = sq
                   j = j + 1
                   a(0, j) = sv(1, 2)
                   a(n, j) = sv(i, 2)
         If b < j Then b = j
     sq = sv(i, 1)
   Next i
 Blad2.Cells(1, 10).Resize(n + 1, b + 1) = a
End Sub

Sub hsv_2()
Dim sv, sq, i As Long
sv = Blad1.UsedRange.Resize(, 2)
With CreateObject("scripting.dictionary")
     For i = 1 To UBound(sv)
        .Item(sv(i, 1)) = .Item(sv(i, 1)) & sv(i, 2) & IIf(sv(i, 2) = "", "", "|")
     Next i
  Blad2.Cells(1, 10).Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
 End With
  Blad2.Columns(11).TextToColumns , , , , , , , , -1, "|"
End Sub