Conversion de données / Délimitation

Bonjour à tous,

Je suis en train de construire un fichier Excel. Et j'ai des données dans des colonnes sont que parfois j'en ai plusieurs séparer par un ";"

Il faudrait que j'utilise la conversion avec délimitation, sauf que je voudrais crée une nouvelle ligne à chaque fois, avec la copie des données des autres colonnes.

Est ce que j'ai été assez clair ?

Bonjour,

pouvez-vous donner un exemple de vos données ?

;blabla;blabla;blabla;

;blabla;blabla;blabla

blabla;blabla;blabla;

ou

blabla;blabla;blabla

Bonjour,

En faite c'est un tableau à 11 colonnes avec une colonnes ou les données sont sous ce format

L54121431000;L54121431001

L54121403000;L54125401000

L54121427000

L54121427000

Il a des ligne ou une seul est présente et d'autre ou il y a deux voir plus.

Julien

Voilà ou j'en suis.

Mais ça plante avec le Rowx("i:i")

Sub Délimitation()
'

Dim L As Long
Dim i, j As Long

Sheets("SBOM").Activate

    Columns("K:K").Select
    Selection.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True

    For i = 2 To 15000
        If Cells(i, 12) <> "" Then
        Rows("i:i").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Cells(i, 12).Select
        Selection.Copy
        Cells(i + 1, 11).Selection
        Seection.Paste

        For j = 1 To 10
            Cells(i, j).Selection
            Selection.Copy
            Cells(i + 1, j).Selection
            Selection.Paste
        Next j

        End If
    Next i

End Sub

Bonjour,

Un exemple à adapter suivant tes informations !?

Cdlt.

Option Explicit

Public Sub TEST()
Dim ws As Worksheet, ws2 As Worksheet
Dim tbl As Variant, Arr() As Variant, x As Variant
Dim i As Long, j As Long, k As Long, m As Long
    Set ws = Worksheets("Feuil1")
    Set ws2 = Worksheets("Feuil2")
    tbl = ws.Cells(1).CurrentRegion.Value
    ws2.Cells(1).CurrentRegion.Offset(1).ClearContents
    For i = 2 To UBound(tbl)
        x = Split(tbl(i, 11), ";")
        For j = LBound(x) To UBound(x)
            ReDim Preserve Arr(11, k + 1)
            For m = 0 To 9
                Arr(m, k) = tbl(i, m + 1)
            Next m
            Arr(10, k) = x(j)
            k = k + 1
        Next j
    Next i
    With ws2
        .Cells(2, 1).Resize(UBound(Arr, 2), 11).Value = Application.Transpose(Arr)
        .Activate
    End With
End Sub