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
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)
@+
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 ? 
Salut @Mimimathy, 
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.
1 « J'aime »
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
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)
@+
Re,
Exercice N°5
Ok, je regarderai ça.
@+
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)
Salut @Mimimathy,
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 qui est en train de répondre.
@+
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 
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 
a toi @mdo100
Et pour le petit plus je préfère votre classeur a celui de @Mimimathy avec le bouton « supprimer »
Cdlt