Macro avec conversion + transposer

Bonjour à tous,

je souhaite à partir d'une cellule (A1) qui contient une liste de champs séparé par le carractère # obtenir chaque carractère, l'un sous l'autre en colonne A .

Voici un exemple de liste : 3608290096542#3608290036050#3608290036050#3608290036050#3608290036050#3608290036050#3608290036050

et voici ce que je souhaite obtenir :

3608290096542

3608290036050

3608290036050

3608290036050

3608290036050

3608290036050

3608290036050

Mon pb est qu'en utilisant l'assistant macro, et l'outil convertir avec séparateur # il fige le nombre de colonne en fonction de ma liste, mais cette liste ne comprendre pas systématiquement le même nombre de champs, il faut donc que la conversion se fasse quelque soit le nombre de # contenu dans la liste.

merci

Sub MEP()

    Range("A1").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="#", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1), Array(6, 1), Array(7, 1)), TrailingMinusNumbers:=True
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.NumberFormat = "0"
    Selection.Copy
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
End Sub

Bonjour,

Essayer :

Sub Test()
    Dim Col
    With ActiveSheet
        Col = Split(.Range("A1"), "#")
        .Range("A1").Resize(UBound(Col) + 1).Value = WorksheetFunction.Transpose(Col)
    End With
End Sub

Cordialement.

Bonjour à tous

ma participation

Sub extraction()
    Dim Tableau() As String
    Dim i%
    Dim j%
        Tableau = Split(Range("A3").Value, "#")
        j = 5
            For i = 0 To UBound(Tableau)
                Selection.NumberFormat = "@"
                Cells(j, 1) = CStr(Tableau(i))
                j = j + 1
            Next i
End Sub

merci super