Code déclaré Public

L

lmc71

XLDnaute Occasionnel
Bonjour le Forum,
J'ai crée une macro avec l'enregistreur de macro me permettant d'extraire des doublons. Elle fonctionne très bien, et je voudrais pouvoir utiliser ce code dans les autres onglets. Elle a été enregistrée sur la feuille JANVIER et je voudrais pouvoir changer les lignes portant le nom de la feuille("Janvier") ActiveWorkbook.Worksheets("Janvier").Sort.SortFields.Clear de façon à rendre ce code utilisable sur tous les autres onglets de ce classeur.
Je voudrais éviter de créer une macro spécifique à chaque onglet. Chose faisable mais très lourd je suppose.
Je ne sais pas faire. Merci de votre aide
Ci-dessous est présent le code enregistré. Merci de pouvoir le modifier.
Amicalement

BONNES FÊTES


Sub Doublon_Trie()
'
' Macro2 Macro
'
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="123", UserInterfaceOnly:=True 'Enlève et remet le mot de passe

'Copie Motif
Range("E5:E152").Select
Selection.Copy
ActiveWindow.LargeScroll ToRight:=1
Range("AA155").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$AA$155:$AA$302").RemoveDuplicates Columns:=1, Header:= _
xlNo
ActiveWorkbook.Worksheets("Janvier").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Janvier").Sort.SortFields.Add Key:=Range("AA155") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Janvier").Sort
.SetRange Range("AA155:AA302")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


'Copie bénéficiaire

Range("F5:F152").Select
Selection.Copy
ActiveWindow.LargeScroll ToRight:=1
Range("AE155").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$AE$155:$AE$302").RemoveDuplicates Columns:=1, Header:= _
xlNo
ActiveWorkbook.Worksheets("Janvier").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Janvier").Sort.SortFields.Add Key:=Range("AE155") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Janvier").Sort
.SetRange Range("AE155:AE302")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Call Dernier_Ligne


End Sub
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Code déclaré Public

Bonjour à tous

lmc71
Tu peux tester sur le fichier Excel que tu as joint dans le premier message de cette discussion...:rolleyes:
Et nous redire si le résultat obtenu est le même qu'avec ta macro initiale, stp ?
Code: 
Sub Tests()
DoublonTrie "Janvier"
End Sub
Code: 
Private Sub DoublonTrie(Feuille As String)
    With Sheets(Feuille)
        .Range("AA155:AE302").ClearContents
        .Range("AA155:AB302").Value = .Range("E5:F152").Value
        .Range("$AA$155:$AB$302").RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range( _
                "AA155:AA302"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                xlSortNormal
        .Sort.SortFields.Add Key:=Range( _
                "AB155:AB302"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                xlSortNormal
            With .Sort
                .SetRange Range("AA155:AB302")
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        .Columns("AB:AD").Insert Shift:=xlToRight
    End With
End Sub
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Code déclaré Public

Bonjour Drannreb ;)

Oui.
Pourquoi pas, en effet ?
Tout simplement parce que je n'y ai pas pensé ;)

Voila qui désormais fait.
Code: 
Sub TestsII()
DoublonTrie Sheets("JANVIER")
End Sub
Private Sub DoublonTrie(Feuille As Worksheet)
    With Feuille
        .Range("AA155:AE302").ClearContents
        .Range("AA155:AB302").Value = .Range("E5:F152").Value
        .Range("$AA$155:$AB$302").RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=Range( _
                "AA155:AA302"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                xlSortNormal
        .Sort.SortFields.Add Key:=Range( _
                "AB155:AB302"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
                xlSortNormal
            With .Sort
                .SetRange Range("AA155:AB302")
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        .Columns("AB:AD").Insert Shift:=xlToRight
    End With
End Sub
 
Vote positif 0 Vote négatif
L

lmc71

XLDnaute Occasionnel
Re : Code déclaré Public

Re bonjour Staple, Le forum
Merci pour ta réponse rapide.
J'ai regardé, mais rien ne se passe.
Je joins un fichier.
Deux onglets sont visibles ACCUEIL et JANVIER.
J'ai placé des explications dans ces deux onglets pour être, je le pense, plus explicite.
Cordialement et merci de te pencher sur la question.
 

Pièces jointes

  • Compte Internet.zip
    200.8 KB · Affichages: 25
Vote positif 0 Vote négatif
L

lmc71

XLDnaute Occasionnel
Re : Code déclaré Public

Re
Merci également pour Dranreb
J'ai testé TestII, mais apparemment ce n'est pas l'effet escompté car : 1: Cela n'enlève pas les doublons - 2: ne recalcule pas les valeurs - 3: supprime entièrement les valeurs de la colonne bénéficiaire.
Il faudrait que seules les colonnes AA pour Motif et AE pour Bénéficiaire soient remplacées. Cela est, je pense possible.
Cordialement
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Code déclaré Public

Re

lmc71
J'ai regardé, mais rien ne se passe.
Cliquez pour agrandir...
Tu n'as pas du testé...:rolleyes:
Car il se passait bien quelque chose
(et pas vraiment le résultat escompté, d'où l'importance de joindre un fichier exemple dès le premier message)
EDITION: Je viens de voir que tu avais testé

Essaies cette nouvelle mouture simplifiée
Pour tester lances la macro nommée TestIII
Code: 
Sub TestsIII()
DoublonTrie Sheets("JANVIER")
End Sub
Private Sub DoublonTrie(Feuille As Worksheet)
    With Feuille
        .Range("AA155:AA302").Value = .Range("E5:E152").Value
        .Range("AA155:AA302").RemoveDuplicates Columns:=1, Header:=xlNo
        .Range("AE155:AE302").Value = .Range("F5:F152").Value
        .Range("AE155:AE302").RemoveDuplicates Columns:=1, Header:=xlNo
        .Range("AA155:AA302").Sort .Range("AA155:AA302"), xlAscending
        .Range("AE155:AE302").Sort .Range("AE155:AE302"), xlAscending
    End With
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Re : Code déclaré Public

Vous pourriez n'avoir qu'une seule macro pour tous les boutons de mois de la feuille Accueil :
VB: 
Sub ActiverFeuille()
Dim Feuille As Worksheet
Set Feuille = Worksheets(ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text)
Feuille.Visible = True
Application.Goto Feuille.[B5]
End Sub
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Code déclaré Public

Re

Ci-dessous le code avec la suggestion de Dranreb
Code: 
Sub TestsIII()
DoublonTrie Sheets("JANVIER")
End Sub
Private Sub DoublonTrie(Optional ByVal Feuille As Worksheet)
If Feuille Is Nothing Then Set Feuille = ActiveSheet
    With Feuille
        .Range("AA155:AA302").Value = .Range("E5:E152").Value
        .Range("AA155:AA302").RemoveDuplicates Columns:=1, Header:=xlNo
        .Range("AE155:AE302").Value = .Range("F5:F152").Value
        .Range("AE155:AE302").RemoveDuplicates Columns:=1, Header:=xlNo
        .Range("AA155:AA302").Sort .Range("AA155:AA302"), xlAscending
        .Range("AE155:AE302").Sort .Range("AE155:AE302"), xlAscending
    End With
End Sub
 
Vote positif 0 Vote négatif
L

lmc71

XLDnaute Occasionnel
Re : Code déclaré Public

re
En ce qui concerne ma macro doublon, avec ton bout de macro placé en tête de la mienne, tout fonctionne, même en recopiant un onglet et le renommant.
Merci déjà pour ceci et à tous qui se sont pencher sur cette question.
En ce qui concerne ton code activerfeuille, je l'ai essayé et il bloque à ce niveau :
Sub ActiverFeuille()
Dim Feuille As Worksheet
Set Feuille = Worksheets(ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text)
Feuille.Visible = True
Application.Goto Feuille.[B5]
End Sub

donc je ne peux voir comment réagi ton code. Mais ceci n'est pas le plus important.

Du fait que tu as ouvert mon fichier d'exemple. Peux-tu regarder dans l'onglet JANVIER, si tu peux me donner une idée pour la colonne A
Merci d'avance.
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Re : Code déclaré Public

Décomposez alors :
VB: 
Sub ActiverFeuille()
Dim Nom As String, Feuille As Worksheet
On Error Resume Next
Nom = ActiveSheet.Shapes(Application.Caller).TextFrame.Characters.Text
If Err Then MsgBox "La macro ne semble pas avoir été appelée" & vbLf _
   & "par un bouton de formulaire.", vbCritical, "ActiverFeuille": Exit Sub
Set Feuille = Worksheets(Nom)
If Err Then MsgBox "Il n'existe pas de feuille """ & Nom & """.", _
   vbCritical, "ActiverFeuille": Exit Sub
Feuille.Visible = True
Application.Goto Feuille.[B5]
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
XL 2013 Macro décale d'une colonne
Réponses
1
Affichages
269
candido57
C
J
  • Question
XL 2019 Trier efficacement un tableau
Réponses
3
Affichages
308
JMP56
J
A
  • Résolu(e)
XL 2013 Code VBA incompatible avec version Excel
Réponses
2
Affichages
396
Averell1976
A
Usine à gaz
  • Résolu(e)
XL 2021 Sélectionner la 1ère cellule après filtrage
Réponses
2
Affichages
285
Usine à gaz
Usine à gaz
B
  • Question
XL pour MAC Problème macro tri
Réponses
2
Affichages
516
Benjy51190
B
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
2 K
fanou06
F
M
  • Résolu(e)
XL 2016 Filtre auto VBA
Réponses
3
Affichages
579
MickaeL_D
M
S
  • Question
Microsoft 365 Erreur d'exécution '91'
Réponses
11
Affichages
435
Staple1600
Staple1600
G
  • Question
Microsoft 365 tri automatique dates
Réponses
6
Affichages
616
GUERET
G
Roseline
  • Résolu(e)
Microsoft 365 Modifier une liste sur deux onglets
Réponses
11
Affichages
1 K
Roseline
Roseline

Membres actuellement en ligne

6 membres et 98 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
312 215
Messages
2 086 328
Membres
103 180
dernier inscrit
Vcr