Séparer des contacts dans une même cellule et compter leur valeure associée

Bonjour à tous, je bute sur un problème :

J’ai une liste de contacts avec 2 colonnes comme suit :

Une Colonne avec plusieurs contacts séparés par des points virgules

Une colonne avec un nombre associé à chaque ligne

Je souhaite isoler chaque contact et obtenir le nombre associé à la ligne ou il était

Colonne 1 Colonne 2

Pierre jean; sylvian dufour 3

Guillaume Le Breton ; Guillaume Gilles, Martin de Normandie 2

Afin d’obtenir les résultats comme suit :

Colonne 1 Colonne 2

Pierre jean 3

Sylvian dufour 3

Guillaume le breton 2

Guillaume Gilles 2

Martin de Normandie 2

Merci par avance pour votre aide précieuse !

Cordialement

Bonjour,

regarde si cela peut te convenir.

Bonjour Bigdaddy154 ,

C'est exactement ce que je voulais !

Merci d'avoir trouvé la solution

Bien cordialement,

bigdaddy154 a écrit :

Bonjour,

regarde si cela peut te convenir.

Bonjour,

Je travaille sur la même problématique que Ben_R,

Mon objectif c'est globalement le même que Ben_R, mais avec une deuxième partie qui reprend les valeurs de plusieurs colonnes pour tout transférer vers un nouveau tableau dans un nouvel onglet, que j'ai nommé 'Output' sur le fichier.

Je mets en PJ le fichier de travail.

Ma Colonne avec plusieurs contacts séparés par des points virgules c'est la Colonne M.

Les autres colonnes correspondent à des données que je veux isoler pour chaque contact de la colonne M mais dans une ligne qui lui est dédiée.

L'idéal c'est d'avoir le tableau final 'épuré dans l'onglet output.

Je serai reconnaissant de votre aide très précieuse

Bonjour SD_daassi,

Regarde si cela peut te convenir.

Lancement de la macro via CTRL+SHIFT+T.

Bonne journée.

bigdaddy154 a écrit :

Bonjour SD_daassi,

Regarde si cela peut te convenir.

Lancement de la macro via CTRL+SHIFT+T.

Bonne journée.

Bonjour bigdaddy154,

Merci beaucoup pour ton aide.

J'ai essayé la macro c'est top merci.

Quand j'ai fait les tests pour voir s'il y'aurait d'éventuelles défaillances, j'ai trouvé par exemple que pour le champs dans la colonne I: Type de visite = il parait que dans l'onglet d'output il y'a moins d'entrées que dans l'onglet de départ.

Dans l'onglet de départ j'avais comme types de visites:

Visite Client - Individuel

Visite Client - Groupe

Visite Client - Conférence / Evénement

Visite Client - Training

Non Visite - Autres

Non Visite - Administration/Préparation

Non Visite - Congrès / Formation

Non Visite - Coaching

Non Visite - Congés

Non Visite - Maladie

Non Visite - Temps partiel

Par contre dans l'output, il ne m'en reste que 5:

Visite Client - Individuel

Visite Client - Groupe

Visite Client - Conférence / Evénement

Visite Client - Training

Non Visite - Congrès / Formation

C'est peut être révélateur d'une itération qui éventuellement a mal fonctionné.

Merci de ton aide très précieuse !!

SD-Daassi

Hello,

effectivement l'erreur vient du fait que je n'ai pas considéré que ta colonne M pouvait être vide.

Du coup remplace le code exitant par celui ci :

Option Explicit
Option Base 1

Sub test()
    Dim Tab_donnees As Variant
    Dim Tab_Contacts
    Dim A&, B&, C%, Drligne&, LigneOuCopier&

    LigneOuCopier = 2

    With Sheets("Tous les rendez-vous FR")
        Drligne = .Range("A" & Rows.Count).End(xlUp).Row
        Tab_donnees = .Range("A2:AH" & Drligne).Value2
    End With
Application.ScreenUpdating = False
    With Sheets("Output")
        Drligne = .Range("A" & Rows.Count).End(xlUp).Row
        If Drligne > 2 Then Rows(2 & ":" & Drligne).Delete
    End With

    For A = LBound(Tab_donnees) To UBound(Tab_donnees)
        If Tab_donnees(A, 13) <> "" Then
            Tab_Contacts = Split(Tab_donnees(A, 13), ";")
            For B = LBound(Tab_Contacts) To UBound(Tab_Contacts)
                With Sheets("Output")
                    .Range("M" & LigneOuCopier) = Tab_Contacts(B)
                    For C = 1 To 12
                        .Cells(LigneOuCopier, C) = Tab_donnees(A, C)
                    Next C
                    For C = 14 To 34
                        .Cells(LigneOuCopier, C) = Tab_donnees(A, C)
                    Next C
                    LigneOuCopier = LigneOuCopier + 1
                End With
            Next B
        Else
            With Sheets("Output")
                For C = 1 To 34
                    .Cells(LigneOuCopier, C) = Tab_donnees(A, C)
                Next C
                LigneOuCopier = LigneOuCopier + 1
            End With
        End If
    Next A
Application.ScreenUpdating = True
End Sub

C'est juste parfait !

Merci beaucoup pour ton aide !!