VBA pour traitement de données

Bonjour,

Dans le cadre d'un import de fichier je suis confronté au problème suivant :

Je récupère un tableau dont une colonne contient des informations sous forme de texte.

Ce texte est sur plusieurs lignes au sein de la même cellule.

Problème : pour importer mes données une ligne de texte doit correspondre à une ligne d'import donc en résumé chaque ligne de ma cellule doit correspondre à une ligne excel tout en conservant les même valeurs dans les autres colonnes pour cet enregistrement... j'espère que je suis clair...

Donc je cherche une solution pour :

• Compter le nombre de lignes dans la cellule.
• Générer autant de lignes excel que le comptage - 1
• Ré-eclater chaque ligne de texte de la cellule dans une des lignes générées et de préférence dans le même ordre.
• Conserver les même valeurs dans les autres cellules pour les lignes générées.

Exemple :

A A A B

C

D

Devient :

A A A B

A A A C

A A A D

Merci d'avance à ceux qui souhaiterons se joindre à mon casse-tête et proposer des solutions ! N'hésitez surtout pas à me demander des infos complémentaires si mon explication manque de clarté...

Ps : pour plus de clarté un exemple si joint :

https://www.excel-pratique.com/~files/doc/GJmFSExemple1.xls

Merci

Édition par Mytå, pour correction des balises URL

Bonjour,

Une proposition par code VBA

A adapter, le code est commenté

Le fichier :

https://www.excel-pratique.com/~files/doc/Pouch_v1.xls

Le code :

Sub eclate()
Application.ScreenUpdating = False  'Désactive le raffraichissement de l'écran
Cells(1, 5).Resize(, 10).EntireColumn.Insert  'on insère 10 colonnes à droite (à adapter
                                                'on fonction du nombre de lignes max dans
                                                'les cellules
For i = [D65000].End(xlUp).Row To 2 Step -1     'on part de la dernière ligne, vers la ligne 2
    y = Len(Cells(i, 4)) - Len(Replace(Cells(i, 4), Chr(10), ""))   'Calcul du nombre de retour chariot
    Cells(i, 1)(2).Resize(y).EntireRow.Insert   'insertion d'autant de lignes qu'il y a de retour
                                                'chariot sous la cellule traitée
    Cells(i, 4).Replace What:=Chr(10), Replacement:=";" 'remplacement des retours chariots par
                                                        'des points virgule ";"
    Cells(i, 4).TextToColumns Destination:=Cells(i, 4), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote                    'on convertit la cellule (Données/Convertir)
    Cells(i, 5).Resize(1, y).Copy                       'on copie les données converties
    Cells(i + 1, 4).PasteSpecial Paste:=xlPasteAll, Transpose:=True 'on colle, en transposant dans
                                                        'les lignes insérées
Next i
With Range("A2:C" & [D65000].End(xlUp).Row)             'dans les cellules vides des colonnes A à C
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" 'on met une formule = cellule du dessus
    .Value = .Value                                     'on remplace la formule par sa valeur
End With
With Range("A2:D" & [D65000].End(xlUp).Row).Borders     'pour tout le tableau
    .LineStyle = xlContinuous                           'on met une bordure
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
Cells(1, 5).Resize(, 10).EntireColumn.Delete        'on supprime les colonnes insérées au début
End Sub