Dans VBA : dupliquer des lignes contenant des retours chariots

Résolu/Fermé
Loic - 5 déc. 2012 à 20:53
 Loïc - 6 déc. 2012 à 11:14
Bonjour,

J'ai une liste. Chaque ligne contient une personne. Les colonnes A à F contiennent les coordonnées. La colonne G contient les options choisies. Lorsque plusieurs options sont choisies elles sont séparées par un retour chariot (chr(10)).
Je voudrai avoir une liste à plat avec une option par ligne (et plusieurs fois la même personne lorsqu'elle a plusieurs options).

Je n'arrive pas à détecter avec vba les cellules qui contiennent un retour chariot.

J'ai essayé avec "InStr(Chr(10), cellule_option, 0)" qui me renvoie toujours un message "Type incompatible (erreur 13)".

Quelqu'un a-t-il une solution.
Merci d'avance.

, office 2010.

3 réponses

eriiic Messages postés 24584 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 18 juin 2024 7 225
6 déc. 2012 à 00:12
Bonsoir,

Si toi avec le fichier source tu ne vois pas, imagine ce que l'on peut voir nous sans ce fichier.
Et met aussi un exemple du résultat attendu.

Déposer le fichier *.xls (réduit au nécessaire et anonymisé) sur cjoint.com et coller ici le lien fourni.

eric
0
Bonjour Eric,

Le fichier contenant le format initial et le format souhaité est ici : http://cjoint.com/?BLgjb2fCcME
Merci du temps consacré à m'aider.

Bien cordialement,
Loïc
0
eriiic Messages postés 24584 Date d'inscription mardi 11 septembre 2007 Statut Contributeur Dernière intervention 18 juin 2024 7 225
Modifié par eriiic le 6/12/2012 à 10:51
Bonjour,

le séparateur est bien chr(10), je n'ai pas eu de problème...
Sub dupliquer() 
    Dim lig As Long, lig2 As Long, domaine As Variant, i As Long 
    Dim sh As Worksheet 
    Set sh = Worksheets("Feuil2") 
    Application.ScreenUpdating = False 
    sh.Cells.ClearContents 
    Cells(1, 1).Resize(1, 7).Copy sh.Cells(1, 1) 
    lig2 = 2 
    For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row 
        domaine = Split(Cells(lig, "G"), vbLf) 
        For i = 0 To UBound(domaine) 
            Cells(lig, 1).Resize(1, 6).Copy sh.Cells(lig2, 1) 
            sh.Cells(lig2, 7) = domaine(i) 
            lig2 = lig2 + 1 
        Next i 
    Next lig 
    Application.ScreenUpdating = True 
    sh.Activate 
End Sub

https://www.cjoint.com/?BLgkZeXUafX
je ne teste pas si Gx est vide....

eric

Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait.
0
Merci beaucoup Eric!
C'est parfait.

Cordialement,
Loïc
0