Dupliquer lignes distribuant le contenu d'autres cellules

Bonjour à tous,

Ca fait une semaine que je sèche sur un fichier excel contenant plus de 8000 lignes.

Mon objectif est de prendre des informations contenant dans deux cellules et de les séparer en ligne.

pour plus d'explication, j'ai mis un fichier exemple en attache,

il peut avoir plusieurs numéros de dossiers séparé par un "/" pour un employé sous la forme 2548/ 9654/6351/6480 (dans une seule cellule) avec leur status respectif active/active/desactive/active 'dans une seule cellule). Je souhaite un macro qui crée autant de ligne nécessaire pour dissocier les numéros de dossier et leur status comme suit

et pour les autres cellules dans les nouvelles lignes, dupliquer la même information.

A noter que si dans la colonne status il y a un seul mot "active" ou "desactive" pour plusieurs numéros de dossiers, c'est le meme status qui va se reproduire pour les numéros.

Je vous laisser consulter le fichier exemple pour une meilleure compréhension.

Merci par avance de votre support. cette solution me sera très utile!

Merci encore

bonjour, comme ceci ?

Sub Mozart()
     Dim Dict, aA, i, aAux
     Set Dict = CreateObject("Scripting.Dictionary")
     aA = Sheets("Avant").Range("A2").CurrentRegion.Value2     'vos données
     ReDim aAux(1 To UBound(aA, 2))     'matrice auxiliaire
     For i = 1 To UBound(aA)     'boucle les lignes
          sp = Split(aA(i, 7), "/")     'séparer les dossiers
          sp1 = Split(aA(i, 8), "/")     'séparer les status
          For j = 0 To UBound(sp)     'boucle les dossiers
               For k = 1 To UBound(aA, 2)     'boucle les colonnes
                    Select Case k
                         Case 7: aAux(k) = sp(j)     '7ième colonne = dossier suivant
                         Case 8: aAux(k) = sp1(Application.Min(UBound(sp1), j))     '8ème colonne = son status ou dernier status si nombre insuffisant
                         Case Else: aAux(k) = aA(i, k)     'les autres colonnes
                    End Select
               Next
               Dict.Add Dict.Count, aAux     'ajouter au dictionaire
          Next
     Next

     If Dict.Count > 1 Then
          Sheets("après").Range("A20").Resize(Dict.Count, UBound(aAux)).Value = Application.Index(Dict.items, 0, 0)     'coller dans la feuille "Après"
     Else
          MsgBox "no data ou insuffisant", vbInformation
     End If
End Sub

Bonjour

Bonjour à tous

Une variante

Bye !

Je vous remercie de votre diligence.

juste deux petites questions,

aA(i, 7), (aA(i, 8) et case 7, case 8 cela correspond au numéro des deux colonnes à spliter?

ce script peut etre appliqué sur un fichier volumineux sans que je renseigne le nombre de ligne?

merci infiniment

bonjour,

Sheets("Avant").Range("A2").CurrentRegion.Value2 >>> cette ligne détecte la plage et la lit dans une matrice, donc il ne faut plus compter les lignes, la matrice le sait déjà et oui, la colonne 7 et 8 sont les dossiers et status à spliter.

Le dictionaire n'a pas de problèmes avec des fichiers volumineux mais pour coller, le nombre doit être inférieur au nombre de lignes de la feuille (=+1.048.000) et supérieur à 1

Bonjour BsAlv

Ca a fonctionné. sauf que ca me donne erreur s'il y a une cellule vide entre les colonnes avant celles à dupliquer.

pour faire fonctionner le code j'ai dû remplir toutes les cellules vides.

Le code pourrait-il prendre en compte le fait qu'il peut avoir des cellules vides, par exemple il peut manquer des noms ou des salaires?

Merci encore

changer cette ligne

Case Else: aAux(k) = aA(i, k) 'les autres colonnes

en

Case Else: if len(aA(i,k))>0 then aAux(k) = aA(i, k) 'les autres colonnes

bonjour,

avec quelque autres modifs, si le status est vide ou les dossiers sont vide.

Savez que, s'il y a par exemple 5 dossiers et seulement 2 status, que les dossiers 2-5 auront le status du 2ième (=dernier)