Exercice N° 6 - Dispatcher une synthèse en plusieurs onglet


#1

Bonjour à tous

Si on fait une Synthèse de plusieurs onglet, pourquoi ne pas créer des onglets par rapport à une Synthèse

Mettre chaque clients dans des onglets séparés

Dispatcher un onglet sur plusieurs feuilles.xlsx (13,1 Ko)


#2

Re @Mimimathy,

Un début, mais il me manque la mise en forme des titres et les largeurs colonnes, je ne trouve pas la solution !

Le code:

Option Explicit
'Declaration des variables utilisees pour la macro
Dim FS As Worksheet, FN As Worksheet, TabloSy, TabloT, Dico As Object, DicoF As Object, cleA
Dim i&, j&, Dl&, NF$

Sub Dispatcher() 'Macro pour dispatcher dans plusieurs onglets selon le_
                  'Nom de Client colonne A de l'onglet Synthese
    
    Set FS = Sheets("Synthese")
    
    TabloT = FS.Range("A7:F7") 'Tableau des Titres feuille Synthese
        
    'Tableau feuille Synthese de A8 jusqu'a la derniere ligne de la colonne F
    TabloSy = FS.Range("A8:F" & FS.Range("A" & Rows.Count).End(xlUp).Row)
    
    'M?moire tampon dans un dictionnaire des titres colonne A
    Set Dico = CreateObject("Scripting.Dictionary")
    
    'M?moire tampon dans un dictionnaire des noms des feuilles deja existantes
    Set DicoF = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False 'Desactivation du rafraichissement d'ecran
    
    'Appel de la macro SupprimerLesFeuilles pour eviter les doublons (Initialisation)
    SupprimerLesFeuilles
    
    'Boucle sur les feuilles deja existantes
    For i = 1 To Worksheets.Count
        DicoF(Sheets(i).Name) = ""
    Next i
    
    'Boucle sur tout le Tableau de la feuille Synthese
    For i = 1 To UBound(TabloSy, 1)
        Dico(Replace(TabloSy(i, 1), "/", "-")) = "" 'Titre de la colonne A
        
        'Nom Feuille premiere lettre en majuscule avec un max de 30 lettres ou chiffres
        NF = UCase(Left(Replace(TabloSy(i, 1), "/", "-"), 30))
        
        'Si la feuille n'existe pas, on la cree
        If Not DicoF.exists(NF) Then
            Sheets.Add After:=FS
            ActiveSheet.Name = NF
            Range("A7").Resize(1, 6) = TabloT
            DicoF(NF) = "" 'On ajoute son nom dans le dictionnaire
        End If
        Set FN = Sheets(NF) 'On ecrit le nom dans les Feuilles Nouelles
        'On d?finit la premi?re ligne disponible
        Dl = FN.Range("A" & Rows.Count).End(xlUp)(2).Row
        For j = 1 To 6
            'On ecrit les titres de la colonne A feuille Synthese dans les Feuilles Nouelles
            FN.Cells(Dl, j) = TabloSy(i, j)
        Next j
    Next i
    'Tri par odre alphabetique les onglets sauf onglet Synthese
    For i = 2 To Worksheets.Count
        For j = i + 1 To Worksheets.Count
            If Worksheets(i).Name > Worksheets(j).Name Then
            Worksheets(j).Move Sheets(i)
            End If
        Next j
    Next i
    'Revenir sur la feuille Synthese
    Sheets("Synthese").Activate
    
End Sub

Sub SupprimerLesFeuilles() 'Macro pour supprimer les onglets sauf Synthese

    Application.DisplayAlerts = False 'Ne pas demander la confimation de suppresssion onglets
    j = Worksheets.Count 'Parcour toutes les feuilles
    For i = j To 2 Step -1 'A partir du 2eme onglet
        Sheets(i).Delete 'Supprime tous les onglets sauf un
    Next i
    Application.DisplayAlerts = True 'Reactive les confirmations
End Sub

Le Fichier ==> Dispatcher un onglet sur plusieurs feuilles V1.xlsm (28,8 Ko)

@+


#3

Salut MDO, oui , si vraiment tu as compris le code, mais, je ne veux pas le nom du client dans les onglets dispatcher, son nom c’est le nom d’onglet

Tu as solutionné la liste déroulante de l’exercice précédent ? :thinking:


#4

Salut @Mimimathy, :wink:

J’ai repris a zéro pour ne plus avoir la colonne A “Nom du client” dans les feuilles dispatchées.

Voici ma proposition:

Le code macro Dispatcher:

Sub Dispatcher()

Dim Dl% 'Variable Dl (Derni?re Ligne)
Dim Pl As Range 'Variable Pl (PLage)
Dim Dico As Object 'Variable Dico (Dictionnaire)
Dim Cel As Range 'Variable Cel (Cellule)
Dim Tp As Variant 'Variable Tp (Tableau Temporaire), "M?moire tampon"
Dim i% 'Variable i (Incr?mentation)
Dim F As Object 'Variable F (Pour nouvelle feuille)

 Application.ScreenUpdating = False 'Desactivation du rafraichissement d'ecran

 With Sheets("Synthese") 'A partir de la feuille "Synthese"
    Dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'Derni?re ligne de la colonne A
    Set Pl = .Range("A7:A" & Dl) 'Plage de A7 ? la Dl
 End With
 Set Dico = CreateObject("Scripting.Dictionary") 'Cr?ation du dictionnaire Dico
 For Each Cel In Pl 'Boucle sur toutes les cellules Cel de la plage Pl
    Dico(Cel.Value) = "" 'Alimentation du Dico (dictionnaire)
 Next Cel 'Fin de la boucle
 Tp = Dico.keys 'r?cup?re le dictionnaire sans doublon dans le tableau temporaire Tp
  For i = 0 To UBound(Tp) 'Boucle sur tous les ?l?ments uniques du tableau Tp
    On Error Resume Next 'Gestion des erreurs, en cas d'erreur, passe ? la ligne suivante
    Set F = Sheets(CStr(Tp(i))) 'Chaine de caract?re String de l'onglet F (g?n?re une erreur si cet onglet n'existe pas)
    If Err <> 0 Then 'Si une erreur <> 0 a ?t? g?n?r?e
        Err = 0 'Annule l'erreur
        Sheets.Add After:=Sheets(1) 'Ajoute un nouvel onglet en deni?re position du premier onglet
        Set F = ActiveSheet 'D?finit l'onglet F
        F.Name = CStr(Tp(i)) 'Nomme le nouvel onglet
    End If
    On Error GoTo 0 'Annule la gestion des erreurs
    F.Cells.Clear 'Efface les anciennes donn?es de l'onglet F
    'Pour ranger dans l'ordre des dates des nouveaux onglets
    Sheets("Synthese").Range("A7").AutoFilter 'Lance le filtre automatique
    Sheets("Synthese").Range("A7").AutoFilter Field:=1, Criteria1:=Tp(i) 'Filtre la colonne A avec Tp(i) comme crit?re
    'Copier les lignes filtr?es dans la cellule A7 de l'onglet F de la colonne B jusqu'? la colonne F
    Pl.Offset(0, 1).Resize(Pl.Rows.Count, 6).SpecialCells(xlCellTypeVisible).Copy F.Range("A7")
    Sheets("Synthese").Range("A7").AutoFilter 'Supprime le filtre automatique
  Next i 'Reboucle jusqu'au prochain ?l?ment du tableau i
 
 'Tri par odre alphabetique les onglets sauf onglet Synthese
    For i = 2 To Worksheets.Count 'Compte a partir de l'onglet 2
        For j = i + 1 To Worksheets.Count 'Compteur d'onglet
            If Worksheets(i).Name > Worksheets(j).Name Then 'Si onglets sup?rieur ? l'onglet Synthese
            Worksheets(j).Move Sheets(i) 'D?place les onglets devant l'onglet Synthese
            End If
        Next j
    Next i
    
    Sheets("Synthese").Activate 'Revenir sur la feuille Synthese
    
    Application.DisplayAlerts = False 'Ne pas demander la confimation de suppresssion onglet
    Worksheets(Worksheets.Count).Delete 'Supprime le dernier onglet
    Application.DisplayAlerts = True 'Reactive les confirmations
 
End Sub

Le code macro Supprimer:

Sub SupprimerLesFeuilles() 'Macro pour supprimer les onglets sauf Synthese

    Application.DisplayAlerts = False 'Ne pas demander la confimation de suppresssion onglets
    j = Worksheets.Count 'Parcour toutes les feuilles
    For i = j To 2 Step -1 'A partir du 2eme onglet
        Sheets(i).Delete 'Supprime tous les onglets sauf un
    Next i
    Application.DisplayAlerts = True 'Reactive les confirmations
    
End Sub

Le Fichier: Dispatcher un onglet sur plusieurs feuilles V2.xlsm (26,1 Ko)

Non et je n’ais pas tout a fait compris ce que tu voulais pour ce complément de l’Exercice N°5.

Bonne fin de dimanche.


#5

Salut MDO
pour le complément, c’est simple, tu ajoutes dans la feuille Synthèse un menu deroulant (combobox) qui aura comme Item les intitulés des colonnes. et en changeant d’intitulé le tri se produit sur la colonne


#6

Re @Mimimathy,

Modif du code afin de ne plus a avoir supprimer la dernière feuille crée par “A7”.

Le code modifié:

Sub Dispatcher()

Dim Dl% 'Variable Dl (Derni?re Ligne)
Dim Pl As Range 'Variable Pl (PLage)
Dim Dico As Object 'Variable Dico (Dictionnaire)
Dim Cel As Range 'Variable Cel (Cellule)
Dim Tp As Variant 'Variable Tp (Tableau Temporaire), "M?moire tampon"
Dim i% 'Variable i (Incr?mentation)
Dim F As Object 'Variable F (Pour nouvelle feuille)

 Application.ScreenUpdating = False 'Desactivation du rafraichissement d'ecran

 With Sheets("Synthese") 'A partir de la feuille "Synthese"
    Dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'Derni?re ligne de la colonne A
    Set Pl = .Range("A7:A" & Dl) 'Plage de A7 ? la Dl
 End With
 Set Dico = CreateObject("Scripting.Dictionary") 'Cr?ation du dictionnaire Dico
 For Each Cel In Pl 'Boucle sur toutes les cellules Cel de la plage Pl
    Dico(Cel.Value) = "" 'Alimentation du Dico (dictionnaire)
 Next Cel 'Fin de la boucle
 Tp = Dico.keys 'r?cup?re le dictionnaire sans doublon dans le tableau temporaire Tp
  For i = 1 To UBound(Tp) 'Boucle sur tous les ?l?ments uniques du tableau Tp sauf A7
    On Error Resume Next 'Gestion des erreurs, en cas d'erreur, passe ? la ligne suivante
    Set F = Sheets(CStr(Tp(i))) 'Chaine de caract?re String de l'onglet F (g?n?re une erreur si cet onglet n'existe pas)
    If Err <> 0 Then 'Si une erreur <> 0 a ?t? g?n?r?e
        Err = 0 'Annule l'erreur
        Sheets.Add After:=Sheets(1) 'Ajoute un nouvel onglet en deni?re position du premier onglet
        Set F = ActiveSheet 'D?finit l'onglet F
        F.Name = CStr(Tp(i)) 'Nomme le nouvel onglet
    End If
    On Error GoTo 0 'Annule la gestion des erreurs
    F.Cells.Clear 'Efface les anciennes donn?es de l'onglet F
    'Pour ranger dans l'ordre des dates des nouveaux onglets
    Sheets("Synthese").Range("A7").AutoFilter 'Lance le filtre automatique
    Sheets("Synthese").Range("A7").AutoFilter Field:=1, Criteria1:=Tp(i) 'Filtre la colonne A avec Tp(i) comme crit?re
    'Copier les lignes filtr?es dans la cellule A7 de l'onglet F de la colonne B jusqu'? la colonne F
    Pl.Offset(0, 1).Resize(Pl.Rows.Count, 6).SpecialCells(xlCellTypeVisible).Copy F.Range("A7")
    Sheets("Synthese").Range("A7").AutoFilter 'Supprime le filtre automatique
  Next i 'Reboucle jusqu'au prochain ?l?ment du tableau i
 
 'Tri par odre alphabetique les onglets sauf onglet Synthese
    For i = 2 To Worksheets.Count 'Compte a partir de l'onglet 2
        For j = i + 1 To Worksheets.Count 'Compteur d'onglet
            If Worksheets(i).Name > Worksheets(j).Name Then 'Si onglets sup?rieur ? l'onglet Synthese
            Worksheets(j).Move Sheets(i) 'D?place les onglets devant l'onglet Synthese
            End If
        Next j
    Next i
    
    Sheets("Synthese").Activate 'Revenir sur la feuille Synthese
 
End Sub

Le fichier: Dispatcher un onglet sur plusieurs feuilles V3.xlsm (26,1 Ko)

@+


#7

Re,

Exercice N°5

Ok, je regarderai ça.

@+


#8

Salut MDO

Rien à dire, si ce n’est que j’espère que tu as assimilé le fonctionnement du Dictionnaire et de UBound

Voici deux versions dont une ressemeblant à la tienne

Dispatcher un onglet sur plusieurs feuilles.xlsm (24,9 Ko)
Dispatcher un onglet sur plusieurs feuilles2.xlsm (21,3 Ko)


#9

Salut @Mimimathy, :wink:

Pour l’utilisation de Dictionnaire et de UBound, je me suis aidé avec:

Pour ce qui est de ta 2ème version, je l’aime bien, car les feuilles clients sont dans l’ordre sans être obliger de les trier et surtout avec la mise en forme.

Merci.

PS: Salut à @kiss6 :wink: qui est en train de répondre.

@+


#10

Re,

Bonjour @Mimimathy , @mdo100

Lorsque je vois le travail de @mdo100 je me dit qu’il a quand même une certaine connaissance du VBA

Si non comment savoir que

veut dire "désactivation du rafraichissement d’écran"

ou alors que

veut dire que l’on "crée le dictionnaire Dico"

ETC

Tous c’la il faut le savoir quand même :clap: :clap: a lui

Je suis loin d’être a son niveau je ne sais pas ou on peut apprendre tout c’la peut être en retournant a l’école

Encore :clap: :clap: :+1: a toi @mdo100

Et pour le petit plus je préfère votre classeur a celui de @Mimimathy avec le bouton "supprimer"

Cdlt

@kiss6