Copier dans ligne dans l'onglet du même nom.

Résolu/Fermé
Franck1406 Messages postés 2 Date d'inscription mardi 24 juillet 2018 Statut Membre Dernière intervention 24 juillet 2018 - 24 juil. 2018 à 14:44
 Warwick - 19 août 2020 à 16:39
Bonjour,

Je travaille sur un fichier Excel qui comporte environ 20,000 lignes. Dans la première colonne se trouve une information "clé" qui me sert de filtre et tri. J'ai une macro qui fonctionne qui me crée de nouvelles feuilles Excel en leur donnant le nom d'une des valeur clé (chaque feuille porte un nom de valeur cle).

Je souhaiterais maintenant copier chaque ligne dans le bon onglet.

Par exemple, dans la colonne A, chaque ligne dont la valeur en A est "toto", est copiée à la suite dans l'onglet toto, etc. J'ai trouvé des macro qui déplace les ligne en Feuil2 uniquement mais je n'arrive pas à les adapter. J'aurais besoin que chaque ligne aille dans la feuille du même nom.

Merci pour votre aide.

2 réponses

ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
24 juil. 2018 à 16:10
Bonjour Franck, bonjour le forum,

Essaie comme ça :
Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim L As Long 'déclare la variable L (incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("Feuil1") 'définit l'onglet source OS (à adapter à ton cas)
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 1)) = "" 'alimente le dictionnaire avec la donnée en colonne 1 de TV
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère 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
    On Error Resume Next 'gestionndes erreurs (en cas d'erreur passe à la ligne suivante)
    Set OD = Worksheets(TMP(J)) 'définit l'onglet de destination OD (génère une erreur si cet onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Sheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet en dernière position
        Set OD = ActiveSheet 'définit l'onglet OD
        OD.Name = TMP(J) 'renomme l'onglet OD
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    OD.Cells.ClearContents 'efface toutes les cellules de l'onglet OD (au cas où l'onglet existait déja))
    OD.Range("A1").Resize(1, UBound(TV, 2)).Value = Application.Index(TV, 1) 'renvoie en A1 redimensionnée, la ligne de titre (la ligne 1 du tableau des valeurs TV)
    K = 1: Erase TL 'initialise la variable K, efface le tableau des valeurs TV
    For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
        If TV(I, 1) = TMP(J) Then 'si la donnée ligne I colonne I est égale à la donnée TMP(J)
            ReDim Preserve TL(1 To UBound(TV, 2), 1 To K) 'redimensionne le tableau des lignes TL (autant de lignes que TV a de colonnes, K colonnes)
            For L = 1 To UBound(TV, 2) 'boucle 3 : sur toutes les colonne de TV
                TL(L, K) = TV(I, L) 'récupère en ligne L de TL la donnée en colonne L de TV (=> transposition)
            Next L 'prochaine colonne de la boucle 3
            K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    OD.Range("A2").Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans A2 redimensionné de l'onglet OD, le tab;eau TL transposé
Next J 'prochaien élément de la boucle 1
End Sub

2
Merci cela m'a beaucoup servi
0
Franck1406 Messages postés 2 Date d'inscription mardi 24 juillet 2018 Statut Membre Dernière intervention 24 juillet 2018
24 juil. 2018 à 16:31
Waa super ca marche très bien !

Je débute en VBA, l'idée de départ me semblait un bon exercice mais jamais je n'aurais pu produire cette macro.

Maintenant je vais essayer de décortiquer tout ca pour bien comprendre.

Merci beaucoup !!
0