Liaison de plusieurs feuilles suite
Bonjour,
Voilà, j'ai reconstruit une base avec des identités fictives
Puis fait une copie de la base (feuille 1) sur plusieurs feuilles qui suivent puis trié ces feuilles selon des critères différents, feuilles à conserver pour utiliser ces différents tris
Alors j'entrevois une solution telle que vous me suggérez à travers vos interrogations
Ce serait de :
Créer la base : enregistrer le fichier
Copier la base dans une nouveau fichier, trier autrement, puis enregistrer
Et ainsi de suite
MAIS La modification de la base n'incrémentera pas les autres fichiers !!!!
Mon souci : modifier une base ET toutes les copies de cette base
Je crains fort que cela ne soit pas possible
Sauf, peut-être, avec des macros
Chose que je ne maîtrise absolument pas, à mon grand regret
Je joins mon fichier complété
Merci encore
Pierre
Bonjour
Un essai (surement améliorable)
Tu cliques sur le Bouton MAJ
Code Module
Sub Tris_multiples()
Application.ScreenUpdating = False
Sheets("o.adhésion").Select
Range("A8:M" & [D65000].End(xlUp).Row).Select
Selection.Copy
Sheets(Array("o.alpha", "l.diffus", "âges", "annivers")).Select
Range("A8").Select
ActiveSheet.Paste
Sheets("o.alpha").Select
Selection.Sort Key1:=Range("D8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("l.diffus").Select
Selection.Sort Key1:=Range("J8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("âges").Select
Selection.Sort Key1:=Range("L8"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets("annivers").Select
Range("M8", Range("M8").End(xlDown)).Select
Selection.FormulaR1C1 = "=MONTH(RC[-2])*100+DAY(RC[-2])"
Selection.NumberFormat = "0"
With Selection.Font
.Name = "Verdana"
.FontStyle = "Gras"
.Size = 8
.ColorIndex = 13
End With
Range("A8:M" & [D65000].End(xlUp).Row).Select
Selection.Sort Key1:=Range("M8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Sheets(Array("o.adhésion", "o.alpha", "l.diffus", "âges", "annivers")).Select
Sheets("o.adhésion").Activate
Range("A8").Select
MsgBox "Tris terminés"
End SubCordialement
Bonjour,
Merci Amadéus
J'ai cliqué sur MAJ trouvé sur la base en haut
Un cartouche Excel s'est ouverte avec mention TRIS TERMINES et la touche OK
Mais plus rien ne se passe
La souris présente un cercle qui tourne sur MAJ
Puis plus rien
Quant à toute votre programmation, je dois dire que c'est de l'hébreu pour moi, à priori
Je regarde votre description et je vais tâcher de comprendre pour transposer dans mon véritable fichier adhérents
Encore merci
Cordialement
Pierre
Bonjour
Si cela peut t'aider, le code commenté en détail
Sub Tris_multiples()
'Bloque le rafraichissement de l'écran
Application.ScreenUpdating = False
'sélectionne la feuille o.adhésion
Sheets("o.adhésion").Select
'sélectionne de A8 à la colonne M un nombre de lignes correspondants à celles de la colonne D
Range("A8:M" & [D65000].End(xlUp).Row).Select
'Copie la plage sélectionnée
Selection.Copy
'Sélectionne les 4 feuilles dont le nom est indiqué
Sheets(Array("o.alpha", "l.diffus", "âges", "annivers")).Select
'Sur ces 4 feuilles, sélectionne la cellule A8
Range("A8").Select
'colle sur les 4 feuilles le tableau de la feuille o.adhésion
ActiveSheet.Paste
'Sélectionne la feuille o.alpha
Sheets("o.alpha").Select
'Tri le tableau en ordre croissant à partir de D8
Selection.Sort Key1:=Range("D8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Tri le tableau de la feuille suivante à partir de J8, en ordre croissant
Sheets("l.diffus").Select
Selection.Sort Key1:=Range("J8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Tri le tableau de la feuille suivante à partir de L8 en ordre décroissant
Sheets("âges").Select
Selection.Sort Key1:=Range("L8"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Sélectionne la feuille annivers
Sheets("annivers").Select
'Sélectionne la colonne M de M8 à la dernière cellule pleine
Range("M8", Range("M8").End(xlDown)).Select
'Met cette formule dans la sélection
Selection.FormulaR1C1 = "=MONTH(RC[-2])*100+DAY(RC[-2])"
'Met la sélection au format nombre entiers
Selection.NumberFormat = "0"
'Met en forme les caractères de cette sélection (Police,Gras,Taille, Couleur)
With Selection.Font
.Name = "Verdana"
.FontStyle = "Gras"
.Size = 8
.ColorIndex = 13
End With
'Sélectionne sur cette feuille de A8 à la colonne M un nombre de lignes correspondants à celles de la colonne D
Range("A8:M" & [D65000].End(xlUp).Row).Select
'Tri le tableau en ordre croissant colonne M
Selection.Sort Key1:=Range("M8"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'Sélectionne les 5 feuilles dont le nom est indiqué
Sheets(Array("o.adhésion", "o.alpha", "l.diffus", "âges", "annivers")).Select
'Et active la première
Sheets("o.adhésion").Activate
'Sélectionne A8 (supprime les sélections dans les autres feuilles)
Range("A8").Select
'Affiche le message indiquant que les tris sont terminés
MsgBox "Tris terminés"
End SubCordialement
Bonsoir Amadéus,
Je suis vraiment navré de vous voir dépenser autant d'énergie et de temps pour tenter de résoudre mon problème
Je ne suis pas en mesure de comprendre et de transposer toutes les commandes que vous indiquez
Je ne sais comment les utiliser
Je pense que je vous dérange pour rien, en fait.
Je veux bien essayer d'y comprendre quelque chose
Mais dites moi ce que je dois copier, dans quelles cellules.
Pardon pour autant de méconnaissances
Pierre
Bonjour
Il n'y a rien à recopier dans des cellules
Tu ouvres le fichier
Touches Alt+F11
Double click sur Module1 pour voir le Code.
Pour simplifier, si ton fichier a la même présentation que celui envoyé, tu ouvres le tien et celui-là,
Alt+F11 ouvre l'éditeur VBA
Tu peux y lire le nom des deux fichiers du style VBAProject(Adhérents...)
Tu fais glisser Module1 de ce fichier sur VBAProject(Ton fichier)
tu fermes l'éditeur VBA (La croix rouge habituelle, en haut à droite)
Sur ton fichier, menu "Outils" "Macro">"Macros" (La macro est sélectionnée)
et dans la fenêtre qui s'ouvre, tu cliques sur "Exécuter"
Cordialement