Macro pour extraire des onglets

N

niiiiiiiiiico

XLDnaute Occasionnel
Bonjour,

J'ai créé une macro via l'enregistreur d'excel pour copier deux feuilles dans un nouveau classeur. Ces deux feuilles ont elles même des macros pour effectuer des tris.

Voici ma macro pour extraire :

Code: 
Sub extract_actions()
'
' extract_actions Macro
' Macro enregistrée le 24/08/2009 par ncharles
'

'
    Sheets(Array("Recap Actions1", "Recap Actions2")).Select
    Sheets("Recap Actions2").Activate
    Sheets(Array("Recap Actions1", "Recap Actions2")).Copy
    ActiveSheet.Unprotect
    ActiveSheet.Shapes("AutoShape 14").Select
    Selection.Delete
    Sheets("Recap Actions2").Select
    ActiveSheet.Unprotect
    ActiveSheet.Shapes("AutoShape 13").Select
    Selection.Delete
    ActiveSheet.Shapes("Rectangle 7").Select
    Selection.OnAction = "Feuil40.tri_raz_recap_actions"
    ActiveSheet.Shapes("Rectangle 8").Select
    Selection.OnAction = "Feuil40.tri_EVRP_recap_actions"
    ActiveSheet.Shapes("Rectangle 9").Select
    Selection.OnAction = "Feuil40.tri_AT_recap_actions"
    ActiveSheet.Shapes("Rectangle 10").Select
    Selection.OnAction = "Feuil40.tri_tout_recap_actions"
    Range("C7").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Sheets("Recap Actions1").Select
    ActiveSheet.Shapes("Rectangle 7").Select
    Selection.OnAction = "Feuil39.tri_raz_recap_actions"
    Range("E4").Select
    ActiveSheet.Shapes("Rectangle 8").Select
    Selection.OnAction = "Feuil39.tri_EVRP_recap_actions"
    ActiveSheet.Shapes("Rectangle 9").Select
    Selection.OnAction = "Feuil39.tri_AT_recap_actions"
    ActiveSheet.Shapes("Rectangle 10").Select
    Selection.OnAction = "Feuil39.tri_tout_recap_actions"
    Range("C7").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Sub

Pourtant quand je veux utiliser mes macros de tri dans mon nouveau classeur, elles font références aux macros du classeur d'origine et je ne comprends pas pourquoi:confused:

Dans mes deux feuilles (39 et 40), j'ai ce code :

Code: 
Sub tri_raz_recap_actions()
'
' tri_raz_recap_actions Macro
' Macro enregistrée le 21/07/2009 par ncharles
'

'
ActiveSheet.Unprotect
Selection.AutoFilter Field:=1
    Range("B7:H1856").Select
    Range("H1856").Activate

    Selection.Sort Key1:=Range("B7"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("C7").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End Sub

Sub tri_EVRP_recap_actions()
'
' tri_raz_recap_actions Macro
' Macro enregistrée le 21/07/2009 par ncharles
'

'
ActiveSheet.Unprotect
Selection.AutoFilter Field:=1
    Range("B6:H1856").Select
    Range("H1856").Activate
        Selection.Sort Key1:=Range("c6"), Order1:=xlDescending, Key2:=Range("f6"), _
        Order2:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Selection.AutoFilter Field:=1, Criteria1:="EVRP"
    Range("C7").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End Sub
Sub tri_AT_recap_actions()

'
' tri_raz_recap_actions Macro
' Macro enregistrée le 21/07/2009 par ncharles
'

'
ActiveSheet.Unprotect
Selection.AutoFilter Field:=1
    Range("B6:H1856").Select
    Range("H1856").Activate
        Selection.Sort Key1:=Range("c6"), Order1:=xlDescending, Key2:=Range("f6"), _
        Order2:=xlDescending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Selection.AutoFilter Field:=1, Criteria1:="AT"
    ActiveWindow.SmallScroll Down:=-1
    Range("C7").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End Sub
Sub tri_tout_recap_actions()

'
' tri_raz_recap_actions Macro
' Macro enregistrée le 21/07/2009 par ncharles
'

'
ActiveSheet.Unprotect
Selection.AutoFilter Field:=1
    Range("B6:H1856").Select
    Range("H1856").Activate
        Selection.Sort Key1:=Range("c6"), Order1:=xlDescending, Key2:=Range("f6"), _
        Order2:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("C7").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    
End Sub

Avec le fichier 2, j'appuie sur extraire les données et j'obtiens le fichier 1, mais les macros du fichier 1 ne sont pas propres à ce fichier mais renvoit au 2 ! Mes 4 boutons de tri du fichier 1 sont donc inutilisables

En vous remerciant par avance !
 

Pièces jointes

Dernière édition:
Trier par date Trier par votes
JCGL

JCGL

XLDnaute Barbatruc
Re : Macro pour extraire des onglets

Bonjour à tous,

Déjà en présentant ton code avec les balises BB (ici le # en haut après avoir sélectionné ton code).

Code: 
Sub extract_actions()
'
' extract_actions Macro
' Macro enregistrée le 24/08/2009 par ncharles
'

'
    Sheets(Array("Recap Actions1", "Recap Actions2")).Select
    Sheets("Recap Actions2").Activate
    Sheets(Array("Recap Actions1", "Recap Actions2")).Copy
    ActiveSheet.Unprotect
    ActiveSheet.Shapes("AutoShape 14").Select
    Selection.Delete
    Sheets("Recap Actions2").Select
    ActiveSheet.Unprotect
    ActiveSheet.Shapes("AutoShape 13").Select
    Selection.Delete
    ActiveSheet.Shapes("Rectangle 7").Select
    Selection.OnAction = "Feuil40.tri_raz_recap_actions"
    ActiveSheet.Shapes("Rectangle 8").Select
    Selection.OnAction = "Feuil40.tri_EVRP_recap_actions"
    ActiveSheet.Shapes("Rectangle 9").Select
    Selection.OnAction = "Feuil40.tri_AT_recap_actions"
    ActiveSheet.Shapes("Rectangle 10").Select
    Selection.OnAction = "Feuil40.tri_tout_recap_actions"
    Range("C7").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Sheets("Recap Actions1").Select
    ActiveSheet.Shapes("Rectangle 7").Select
    Selection.OnAction = "Feuil39.tri_raz_recap_actions"
    Range("E4").Select
    ActiveSheet.Shapes("Rectangle 8").Select
    Selection.OnAction = "Feuil39.tri_EVRP_recap_actions"
    ActiveSheet.Shapes("Rectangle 9").Select
    Selection.OnAction = "Feuil39.tri_AT_recap_actions"
    ActiveSheet.Shapes("Rectangle 10").Select
    Selection.OnAction = "Feuil39.tri_tout_recap_actions"
    Range("C7").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Sub
Puis :

Code: 
Sub tri_raz_recap_actions()
'
' tri_raz_recap_actions Macro
' Macro enregistrée le 21/07/2009 par ncharles
'

'
ActiveSheet.Unprotect
Selection.AutoFilter Field:=1
    Range("B7:H1856").Select
    Range("H1856").Activate

    Selection.Sort Key1:=Range("B7"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("C7").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End Sub

Sub tri_EVRP_recap_actions()
'
' tri_raz_recap_actions Macro
' Macro enregistrée le 21/07/2009 par ncharles
'

'
ActiveSheet.Unprotect
Selection.AutoFilter Field:=1
    Range("B6:H1856").Select
    Range("H1856").Activate
        Selection.Sort Key1:=Range("c6"), Order1:=xlDescending, Key2:=Range("f6"), _
        Order2:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Selection.AutoFilter Field:=1, Criteria1:="EVRP"
    Range("C7").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End Sub
Sub tri_AT_recap_actions()

'
' tri_raz_recap_actions Macro
' Macro enregistrée le 21/07/2009 par ncharles
'

'
ActiveSheet.Unprotect
Selection.AutoFilter Field:=1
    Range("B6:H1856").Select
    Range("H1856").Activate
        Selection.Sort Key1:=Range("c6"), Order1:=xlDescending, Key2:=Range("f6"), _
        Order2:=xlDescending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Selection.AutoFilter Field:=1, Criteria1:="AT"
    ActiveWindow.SmallScroll Down:=-1
    Range("C7").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
End Sub
Sub tri_tout_recap_actions()

'
' tri_raz_recap_actions Macro
' Macro enregistrée le 21/07/2009 par ncharles
'

'
ActiveSheet.Unprotect
Selection.AutoFilter Field:=1
    Range("B6:H1856").Select
    Range("H1856").Activate
        Selection.Sort Key1:=Range("c6"), Order1:=xlDescending, Key2:=Range("f6"), _
        Order2:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("C7").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    
End Sub
Ensuite en déposant ton fichier... Dépouillé de quelques lignes et zippé, il devrait passer
Beaucoup plus simple pour tenter de t'aider

A+ à tous
 
Vote positif 0 Vote négatif
JCGL

JCGL

XLDnaute Barbatruc
Re : Macro pour extraire des onglets

Bonjour à tous,
Re Nico,

Difficile de t'en dire plus : tes codes sont appelés par C:\.......\Marissa....

J'ai test en rompant les liaisons et l'"Extraction" fonctionne.
Ce n'est pas vraiment une extraction mais plutôt une copie de classeur.
Il y aurait certainement plus simple...

D'autre part, tu pourrais mettre en application ceci qui accélérait tes codes :


​



A+ à tous
 
Dernière édition:
Vote positif 0 Vote négatif
N

niiiiiiiiiico

XLDnaute Occasionnel
Re : Macro pour extraire des onglets

Re JCGL,

Mais d'où viens cette liaison alors que dans la macro (ci-après), je réaffecte les 4 macros de tri ?

Code: 
Sub Extract_actions()
'
' Extract_actions Macro
' Macro enregistrée le 26/08/2009 par ncharles
'

'
    Sheets(Array("Recap Actions1", "Recap Actions2")).Select
    Sheets("Recap Actions2").Activate
    Sheets(Array("Recap Actions1", "Recap Actions2")).Copy
    ActiveSheet.Unprotect
    Sheets("Recap Actions2").Select
    ActiveSheet.Unprotect
    ActiveSheet.Shapes("AutoShape 13").Select
    Selection.Delete
    Sheets("Recap Actions1").Select
    ActiveSheet.Shapes("AutoShape 14").Select
    Selection.Delete
    ActiveSheet.Shapes("Text Box 11").Select
    Selection.Delete
    ActiveSheet.Shapes("Rectangle 7").Select
    Selection.OnAction = "tri_raz_recap_actions"
    ActiveSheet.Shapes("Rectangle 8").Select
    Selection.OnAction = "tri_AT_recap_actions"
    Selection.OnAction = "tri_EVRP_recap_actions"
    ActiveSheet.Shapes("Rectangle 9").Select
    Selection.OnAction = "tri_AT_recap_actions"
    ActiveSheet.Shapes("Rectangle 10").Select
    Selection.OnAction = "tri_tout_recap_actions"
    Sheets("Recap Actions2").Select
    ActiveSheet.Shapes("Rectangle 7").Select
    Selection.OnAction = "tri_raz_recap_actions"
    ActiveSheet.Shapes("Rectangle 8").Select
    Selection.OnAction = "tri_EVRP_recap_actions"
    ActiveSheet.Shapes("Rectangle 9").Select
    Selection.OnAction = "tri_AT_recap_actions"
    ActiveSheet.Shapes("Rectangle 10").Select
    Selection.OnAction = "tri_tout_recap_actions"
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
    Sheets("Recap Actions1").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True
End Sub

Pour l'optimisation, je vais regarder cela, merci !
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
17
Affichages
821
MICHAEL
M
D
  • Question Question
XL 2010 Identification d'une cellule cliquée
Réponses
6
Affichages
621
dadu35
D
halecs93
  • Question Question
XL 2016 protéger et déprotéger plusieurs feuilles par macro
Réponses
4
Affichages
831
halecs93
halecs93
PatFr38
  • Résolu(e)
Microsoft 365 Code VBA pour vérifier si lignes masquées le sont bien
2
Réponses
16
Affichages
1 K
PatFr38
PatFr38
Usine à gaz
  • Résolu(e)
XL 2021 touches Ctrl+R pour revenir
Réponses
4
Affichages
484
TooFatBoy
TooFatBoy
O
  • Question Question
XL 2019 protection de feuille par macro
Réponses
3
Affichages
657
Deadpool_CC
Deadpool_CC
A
  • Résolu(e)
XL 2019 Confirmer la modification d'une cellule avant de la protéger en suite
Réponses
10
Affichages
814
arnoldbrice19
A
lestoiles1
  • Question Question
XL 2013 Fonction vba copie coller
Réponses
1
Affichages
952
job75
job75
Usine à gaz
  • Résolu(e)
Microsoft 365 Macro modification que je ne sais pas faire
5 6 7
Réponses
98
Affichages
6 K
TooFatBoy
TooFatBoy
Usine à gaz
  • Question Question
Microsoft 365 Explorateur d'objets vba ouverture intempestive (pour moi)
2 3 4
Réponses
45
Affichages
4 K
TooFatBoy
TooFatBoy
J
  • Résolu(e)
Microsoft 365 Copier coller sous conditions
Réponses
2
Affichages
1 K
JiBee
J
Usine à gaz
  • Question Question
Microsoft 365 simuler clic sur un bouton macro
Réponses
12
Affichages
1 K
Usine à gaz
Usine à gaz
Usine à gaz
  • Question Question
Microsoft 365 Recherche Find : impossible dans lignes masquées par le filtre
2 3
Réponses
38
Affichages
3 K
Usine à gaz
Usine à gaz
T
  • Question Question
Microsoft 365 changer la Couleur de fond d'une forme suivant un text
Réponses
6
Affichages
579
soan
S
Usine à gaz
  • Résolu(e)
Microsoft 365 Variable non définie
Réponses
12
Affichages
1 K
Usine à gaz
Usine à gaz
Usine à gaz
  • Question Question
Microsoft 365 tri trop long
Réponses
14
Affichages
1 K
Usine à gaz
Usine à gaz
Usine à gaz
  • Résolu(e)
Microsoft 365 Tri sur colonnes définies
Réponses
3
Affichages
587
Usine à gaz
Usine à gaz
Usine à gaz
  • Résolu(e)
Microsoft 365 PDF nom = Range("p3") de la feuille "RdVCx".Value
Réponses
7
Affichages
1 K
Usine à gaz
Usine à gaz
N
  • Résolu(e)
XL 2016 Frm de recherche VBA (userform)
Réponses
14
Affichages
2 K
nounou1902
N
N
  • Question Question
XL pour MAC Verouillage de celulles pour eviter le remplissage intempestif
2
Réponses
20
Affichages
2 K
nobodyuse
N

Membres actuellement en ligne

3 membres et 77 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 283
Messages
2 118 012
Membres
113 407
dernier inscrit
FITAS