XL 2013 Transposer colonnes en lignes

Sub transposition()
    Dim T, Tout, L, i, j, Article, T0
    T0 = Timer
    T = [A1].CurrentRegion
    ReDim Tout(UBound(T, 1) * UBound(T, 2), 1)
    L = 0
    For i = 2 To UBound(T)
        Article = T(i, 1)
        For j = 2 To UBound(T, 2)
            If T(i, j) = "" Then Exit For
            Tout(L, 0) = Article: Tout(L, 1) = T(i, j)
            L = L + 1
        Next j
    Next i
   [S2].Resize(UBound(Tout, 1), 1 + UBound(Tout, 2)) = Tout
   MsgBox "Exécuté en " & Round(Timer - T0, 3) & "s"
End Sub