codice:
Option Explicit

Sub trasponi()
Dim i As Integer
Dim j As Integer
Dim valori() As String
Dim valore As Variant
j = 1
For i = 1 To 2
valori = Split(Range("b" & i), ",")
For Each valore In valori
    Sheets(2).Range("a" & j) = Sheets(1).Range("a" & i)
    Sheets(2).Range("b" & j) = valore
    j = j + 1
Next valore
Next i
End Sub