Séparation données "à la ligne" d'une cellule vers cellules distinctes

Bonjour,

A l'export d'un fichier de base de données depuis l'ERP de ma boite, je récupère un fichier Excel dont certaines lignes contiennent des données à la ligne dans la même cellule.

Je souhaiterai séparer les valeurs de chaque saut de ligne de la cellule, en lignes distinctes, tout en reportant les cellules qui n'ont qu'une seule ligne.

Voir fichier anonymisé pour plus de clarté : Feuil1 = format initial / Feuil2 = format attendu

J'ai essayé via formule, sans résultats (bien évidement les lignes sont plus "exotiques" que "DÉSIGNATION PRODUIT 1"), j'ai trouvé des pistes pour une répartition par colonne, mais tous mes essais pour transposer aux lignes décalent à chaque fois toutes les données de la feuille...

Merci d'avance pour vos indications

bonjour spiloides,

avec une macro, parce que 2016 ...

Sub Séparer()
     Dim aA, aOUT
     aA = Sheets("Feuil1").Range("A4").CurrentRegion     'vos données
     ReDim aOUT(1 To 1000, 1 To UBound(aA, 2))     'matrice auxiliaire, changer ce 1.000 vers 10.000, etc si nécessaire
     For i = 1 To UBound(aA)
          sp = Split(aA(i, 4), vbLf)
          For x = 0 To UBound(sp)
               ptr = ptr + 1
               For j = 1 To UBound(aA, 2)
                    If j <= 3 Then
                         aOUT(ptr, j) = IIf(IsNumeric(aA(i, j)), "'", "") & aA(i, j) 'un chiffre doit rester en texte
                    Else
                         s = Split(aA(i, j), vbLf)(x)
                         If IsNumeric(s) Then
                              aOUT(ptr, j) = CDbl(Replace(s, ".", ",")) 'transformer des textes numeriques en numerique
                         Else
                              aOUT(ptr, j) = s
                         End If
                    End If
               Next
          Next
     Next

     Sheets("feuil2").Range("A2").Resize(ptr, UBound(aOUT, 2)).Value = aOUT
End Sub

Merci c'est exactement ça !!

(Et en lisant ce code je mesure l'ampleur de mon ignorance , mais le week-end arrive pour pouvoir décortiquer la procédure plus attentivement...)

re,

avec un peu plus d'explication

Sub Séparer()
     Dim aA, aOUT
     aA = Sheets("Feuil1").Range("A4").CurrentRegion     'vos données
     ReDim aOUT(1 To 1000, 1 To UBound(aA, 2))     'matrice auxiliaire, changer ce 1.000 vers 10.000, etc si nécessaire
     For i = 1 To UBound(aA)                 'boucler les données que vous avez lu
          sp = Split(aA(i, 4), vbLf)         'séparer le contenu de D (N° ligne) avec ce "saute de ligne"
          For x = 0 To UBound(sp)            'boucler autant de fois qu'on a ce "saute de ligne" +1 (mais de 0 à le nombre de fois)
               ptr = ptr + 1                 'pointer, numéro de la ligne qu'on utilise dans la matrice aOUT
               For j = 1 To UBound(aA, 2)    'boucler les colonnes (donc de N° Commande à "Quantité livrée"
                    If j <= 3 Then           'les 3 premières colonnes sont sans saute de ligne, donc copier et coller sauf pour des valeurs numeriques, elles doivent rester "texte"
                         aOUT(ptr, j) = IIf(IsNumeric(aA(i, j)), "'", "") & aA(i, j)     'un chiffre doit rester en texte
                    Else                     'les colonne 4-8 sonta avec ces saute de ligne, donc on doit prendre chaque fois le même partie
                         s = Split(aA(i, j), vbLf)(x)     'séparer le contenu d'une cellule sur ce "saute de ligne" dans une matrice sp et on prend l'élément x (de 0 à ...)
                         If IsNumeric(s) Then     'si c'est une valeur numerique, maintenant elle doit rester numérique + remplacer le point par la virgule
                              aOUT(ptr, j) = CDbl(Replace(s, ".", ","))     'transformer des textes numeriques en numerique
                         Else
                              aOUT(ptr, j) = s     'textes restent textes
                         End If
                    End If
               Next
          Next
     Next

     Sheets("feuil2").Range("A2").Resize(ptr, UBound(aOUT, 2)).Value = aOUT     'coller les premieres "ptr" lignes du contenu de la matrice aOUT vers cette feuille
End Sub