Regrouper ligne avec cellule identique dans differents classeur

Bonjour à tous,

Je viens à vous pour m'aider sur le sujet suivant :

J'ai un classeur dans lequel ce trouve quelques milliers de ligne , mon but est de regrouper

toutes les lignes dont la valeur en colonne F est identique dans des classeurs différents.

regrouper ligne avec cellule identique dans différents classeurs avec pour nom de classeur la valeur de la cellule F.

(exemple de fichier joint)

Merci d'avance du temps passé.

Bonjour Kama, bonjour le forum,

Si ton vrai fichier est strudturé de la même manière que ton exemple, le code ci-dessous pourrait fonctionner. Si le tableau est très très grands ça peut aussi planter...

Le code :

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Long 'déclare la variable NC (Nombre de Colonne)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim J As Integer 'déclare la variable J (incrément)
Dim I As Long 'déclare la variable I (Incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set CS = ThisWorkbook 'définit le classeur Source CS
CA = CS.Path & "\" 'définit le chemin d'accès CA
Set OS = CS.Worksheets(1) 'définit l'onglet source OS
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 1 To NL 'boucle sur toutes les lignes I du tableau des valeurs TV
    D(TV(I, 6)) = "" 'alimente le dictionnaire D avec la donnée en colonne 6 du tableau des valeurs TV
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'renvoie dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For J = 0 To UBound(TMP) 'boucle 1 : sur tous les éléments du tableau temporaire TMP
    Application.Workbooks.Add 'ajoute un classeur vierge
    Set CD = ActiveWorkbook 'définit le classeur destination CD
    Set OD = CD.Worksheets(1) 'définit l'onglet de destination OD
    CD.SaveAs (CA & TMP(J) & ".xlsx") 'enregistre sous le classeur destination CD
    K = 1: Erase TL 'initialise la variable K, vide le tableau TL
    For I = 1 To NL 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV
        If CStr(TV(I, 6)) = CStr(TMP(J)) Then 'condition : si la donnée ligne I colonne 6 de TV correspond à l'élément J du tableau temporaire TMP
            ReDim Preserve TL(1 To NC, 1 To K) 'redimensionne le tableau des lignes TL (NC lignes, K colonnes)
            For L = 1 To NC 'boucle 3 : sur toutes les colonnes L du tableau des valeurs TV
                TL(L, K) = TV(I, L) 'récupère dans la ligne L de TL la valeur de la colonne L de TV (=> transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    OD.Range("A1").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie le tableau TL transposé dans la cellule A1 de l'onglet destination
    CD.Close SaveChanges:=True 'ferme l'onglet destination en enregistrant les changements
Next J 'prochain élément de la boucle 1
End Sub

Bonjour ThauThème,

Un grand merci pour ton aide

Cordialement

Kama