Réduire le nombre de macros

Bonjour à tous,

J'ai créé une macro très simple (SauvegardeSem.01, SauvegardeSem.02...Etc...Etc...) que je dois reproduire 34 fois pour couvrir les 34 semaines de mon fichier. Dans le fichier en pièce jointe, je vous présente 5 semaines sur les 34. Dans cette macro, j'ai inséré d'autres macro avec la fonction "Call".

Est-ce possible de créer une seule macro qui fera le travail des 34 macros ?

Les macros ajoutées avec la fonction "Call" sont très importantes. Elles me permettent de visionner les semaines précédentes dans l'onglet "Sauvegarde, Budget hebdomadaire"et de retourner à la semaine en cour. J'aimerais conserver les boutons ("Sauvegarde, Sem.01", "Semaine suivante", "Semaine précédente") à chaque semaine. À moins qu'il y ait une autre façon de procéder pour obtenir le même résultat.

Merci d'avance pour votre aide.

Bonjour,

Si j'ai bien compris le besoin ...

Si tu dois exécuter la sauvegarde de toutes les semaines, quelques lignes suffisent ...

Sub SauvegardeDesSemaines()

    Application.ScreenUpdating = False
    Range("A4:BM40").Copy

    Worksheets("Sauvegarde, Budget hebdomadaire").Activate
    Range("A4:BM40").PasteSpecial Paste:=xlPasteValues

    Application.CutCopyMode = False
    Worksheets("Budgets hebdomadaires").Activate
    Range("B2").Select

End Sub

Un trou d'un coup ...

"BM" sera à adapter s'il y a plus de semaines ...

ric

Bonjour à tous

Si la sauvegarde ne doit concerner qu'une semaine à la fois et jamais toutes à la fois, il faut renommer tous les boutons avec un nom terminant par 02 à 34 et on récupère le nom du bouton appelant pour déterminer la bonne semaine

Sub SauvegardeSem()

Sem = Application.Caller
Sem = Right(Sem, 2) * 1
    Application.ScreenUpdating = False
    Range("B4:M40").Offset(0, (Sem - 1) * 13).Copy
    With Sheets("Sauvegarde, Budget hebdomadaire")
        .Range("B4").Offset(0, (Sem - 1) * 13).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        .Activate
        .Range("B4").Offset(-2, (Sem - 1) * 13).Select
    End With
    Sheets("Budgets hebdomadaires").Activate
    Range("B4").Offset(-2, (Sem - 1) * 13).Select
    Call SemaineSuivante
End Sub

J'ai modifié les noms des 5 boutons et aussi le nom de la Macro SemaineSuivante

Bonjour à tous,

Désolé Ric mais je dois sauvegarder une semaine à la fois. La macro de 78Chris fonctionne parfaitement bien avec un petit détail que j'aimerais ajouter.

Bonjour 78Chris,

Comme mentionné ci-haut, ta macro fonctionne très bien sauf à un détail prêt. Je ne sais pas si ce sera possible de faire cette action. Je m'explique.

J'ai ajouté l'option "Call AvanceSauvegardeBudgetHebdomadaire" à ta macro. Elle fait avancer les Semaines de l'onglet "Sauvegarde, Budget hebdomadaire" afin qu'elles apparaissent à l'écran pour les visionner, en cliquant sur l'onglet Sauvegarde, Budget hebdomadaire, sans être obligé de les chercher dans les tableaux.

Mon problème est que la première semaine ne doit pas avancer.

Après avoir actionné le bouton "Sauvegarde, Sem.01" dans l'onglet "Budgets hebdomadaires" la Sem.02 apparaît à l'écran. C'est parfait. Avec le "Call AvanceSauvegardeBudgetHebdomadaire" je fais avancer la semaine de l'onglet "Sauvegarde, Budget hebdomadaire". Si la Sem.01 avance, ça fait décaler les Sem. dans l'onglet Sauvegarde, Budget hebdomadaire, une semaine en avant. Je dois reculer pour visionner la semaine courrante.

Cette action est possible avec des macros séparées pour chaque semaine mais avec une macro commune, je ne sais pas.....

Merci pour l'intérêt que tu porte à mon dossier.

Bonjour,

Désolé,

ric

Bonjour Ric,

Tu n'as pas à être désolé. Toutes les réponses peuvent servir.

Merci pour ta tentative et passe une belle soirée. Chez moi il est 16 h

Bonjour à tous,

Une variante du code ...

Sur la feuille "Budgets hebdomadaires", si l'on clique sur bouton "Sauvegarde, Sem 03", la sauvegarde s'effectue et l'affichage passera à la semaine 04.

Sur la feuille "Sauvegarde, Budget hebdomadaire", l'affichage sera lui sur la semaine 03, afin de consulter la dernière sauvegarde.

En exécutant le bouton de la dernière semaine sur la feuille "Budgets hebdomadaires", l'affichage restera à la dernière semaine au lieu de sauter dans le vide puisqu'il n'y a pas d'autres semaines ( un message avisera ).

J'ai dû renommer les boutons "Bouton S01, Bouton S02", etc ... afin de pouvoir avoir 34 semaines (demande d'origine). Mais le code peut aller jusqu'à 99.

La largeur des colonnes des semaines 06 à 10 sera à vérifier, j'ai fait vite. Mais tu peux faire une boucle pour corriger la largeur des colonnes sur les 2 feuilles. Au besoin, je t'en composerai une.

Un gros merci à 78chris ... j'ai utilisé ton code en brassant un peu la sauce.

Il n'y a donc plus de SmallScroll, beaucoup trop restrictif.

Avec les changements, même si tu déplaces un peu une semaine à l'affichage, tant que tu vois encore le bouton, après avoir cliqué pour exécuter la macro, les affichages des 2 feuilles seront replacés correctement.

Espérant ne pas m'être fourvoyé en quelque part ...

Merci encore à 78chris pour le canevas. Après cette absence prolongée, mon ignorance est passablement rouillée.

ric

P.S. Vive Antidote de Druide pour corriger mes coquilles.

Bonsoir Ric,

Merci beaucoup pour ta réponse rapide. Ta macro fonctionne à merveille. C'est exactement ce que je recherchais. Ça m'évite de créer 34 macros pour faire le même travail. En ce qui concerne les colonnes, mon système original a déjà 34 semaines avec les mêmes paramètres. Pas d'inquietude.

J'ai créé une macro qui ramène de la dernière semaine (34) à la Sem.01.

Interrogation : Tu dis avoir renommé les boutons en S01, S02....mais je ne vois pas de changement de noms sur les boutons. Je ne suis par certain de comprendre....Lorsque je transférerai la macro dans mon système original, est ce que je dois changer quelque chose ?

Le range de ta macro est de B4:M40 alors que mon système original se poursuit B4:PZ40). Je présume que je dois changer le M40 dans la macro pour PZ40.

Merci encore pour ton aide.

Bonsoir 78Chris,

Je ne sais plus quoi dire. Tu as créé la base de la macro que Ric a utilisé afin de résoudre mon problème. alors je te dis merci beaucoup pour ton aide et à la prochaine.

Merci à vous deux

Bonjour à tous

Le range de départ B4:M40 correspond à la 1ère semaine mais ensuite tout fonctionne par Offset de 13 en 13 grâce au nom des boutons

Donc ne surtout pas toucher

Tes boutons s'appelaient Bouton 1, Bouton 2 etc... en plus dans le désordre

Comme dit, ils doivent s'appeler Bouton S01 à Bouton S34 sinon rien ne peut fonctionner puisque c'est le nom du bouton qui permet de savoir quelle semaine doit être traitée par la macro unique.

Bonjour à tous,

Interrogation : Tu dis avoir renommé les boutons en S01, S02....mais je ne vois pas de changement de noms sur les boutons. Je ne suis par certain de comprendre....Lorsque je transférerai la macro dans mon système original, est ce que je dois changer quelque chose ?

Je n'ai pas renommé les "Caption" (texte visible), mais leurs noms invisibles. Clique droit sur un bouton pour avoir les poignées qui s'affichent (points aux 4 coins pour redimensionner) , puis regarde à gauche de la barre des formules, l'on voit le nom du bouton. L'on peut renommer un bouton. Le changement sera accepté si tu termines en tapant la touche "Entrée".

Bien heureux que t'en soit heureux ...

ric

Bonjour Ric et 78Chris,

Merci beaucoup pour votre intervention double. Habituellement un seul d'entre vous suffit à répondre à mes questions et je trouve ça génial. Imaginez lorsque deux d'entre vous interviennent, doublement génial.

La macro fonctionne parfaitement dans mon système principal.

J'ai une question, libre à vous d'y répondre ou non : J'ai un autre bouton, "transférer", dans chacune des semaines qui actionne le transfert des données dans tous les tableaux du système. Tout comme mes boutons "Sauvegarde" les noms sont disparates. Présentement, lorsque actionnée elle prend 4 minutes à transférer les données. Si je place les noms en ordre, 01 - 034, est-ce que ça va accélérer le transfert ?

Merci encore à vous deux et passez une belle journée.

Je ferme le dossier

Bonjour,

Effectivement, ce n'est pas normal.

Ces transferts se font sur ta machine, sur le réseau ou sur le cloud ?

Il serait bon de voir ce code pour les transferts.

ric

Bonjour Ric,

Le transfert est sur mon ordi. Aucune liaison avec un réseau ou le cloud.

Mon fichier représente tout prêt de 10 Mo. comme grosseur. Peut être est-ce la cause du transfert lent.

Voici le code au complet incluant les fonctions "Call". Il faut dire que ce code transfère plusieurs données dans plusieurs tableau tout en exécutant le transfert d'une semaine à l'autre.

Ne te sent pas obligé de regarder ce code et de répondre.. Le code fonctionne très bien comme il est, sauf qu'il prend un certain temps à exécuter le transfert.

Sub standar()

Call AbsencesPayées
Call Handicap
Call Moyennes
Call Pointages
Call SoixanteNeuf

Worksheets("Budget").Range("A1:L56").Value = Worksheets("Budget hebdo.").Range("A1:L56").Value

Dim T
Dim V
Dim J As Integer
Dim K As Integer
Dim z As Integer

Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TF() As Variant 'déclare la variable TF (Tableau des Femmes)
Dim TH() As Variant 'déclare la variable TH (Tableau des Hommes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim f As Integer 'déclare la variable F (Femmes)
Dim H As Integer 'déclare la variable H (Hommes)

Dim TX As Variant 'déclare la variable TX (Tableau des Valeurs)
Dim TW() As Variant 'déclare la variable TW (Tableau des Femmes)
Dim TM() As Variant 'déclare la variable TM (Tableau des Hommes)
Dim q As Integer 'déclare la variable P (Incrément)
Dim w As Integer 'déclare la variable W (Femmes)
Dim m As Integer 'déclare la variable M (Hommes)

Dim TY As Variant 'déclare la variable TY (Tableau des Valeurs)
Dim TS() As Variant 'déclare la variable TS (Tableau des Femmes)
Dim TG() As Variant 'déclare la variable TG (Tableau des Hommes)
Dim R As Integer 'déclare la variable R (Incrément)
Dim s As Integer 'déclare la variable S (Femmes)
Dim g As Integer 'déclare la variable G (Hommes)

Application.ScreenUpdating = False

' "Sem.01" >>>> "Sem.30"..................

If ActiveSheet.Name = "Abat.Neuf" Then

Set sh_source = Worksheets("Abat.Neuf")
Set sh_distan = Worksheets("Sem.01")
sh_distan.Range("A1").Value = sh_distan.Name
sh_distan.Range("B2:B180").Value = sh_source.Range("B2:B180").Value

ElseIf Not ActiveSheet.Name = "Abat.Neuf" And Not ActiveSheet.Name = "Données" Then

If Val(Mid(ActiveSheet.Name, 5)) < 9 Then
Set sh_source = Worksheets(ActiveSheet.Name)

Set sh_distan = Worksheets("Sem.0" & (Val(Mid(sh_source.Name, 5)) + 1))
sh_distan.Range("A1").Value = sh_distan.Name
sh_distan.Range("B2:B180").Value = sh_source.Range("B2:B180").Value

ElseIf Val(Mid(ActiveSheet.Name, 5)) >= 9 Then
Set sh_source = Worksheets(ActiveSheet.Name)

Set sh_distan = Worksheets("Sem.0" & (Val(Mid(sh_source.Name, 5)) + 1))
sh_distan.Range("A1").Value = sh_distan.Name
sh_distan.Range("B2:B180").Value = sh_source.Range("B2:B180").Value

End If

End If

If Not sh_source Is Nothing Then

For J = 2 To 180
If sh_source.Range("B" & J).Value <> "" Then
Set T = Worksheets("Données").Range("A2:A1003").Find(sh_source.Range("B" & J).Value, , , xlWhole)
If Not T Is Nothing Then
With Worksheets("Données")

.Range("H" & T.Row).Value = .Range("H" & T.Row).Value + sh_source.Range("M" & J).Value
.Range("I" & T.Row).Value = .Range("I" & T.Row).Value + sh_source.Range("N" & J).Value
.Range("K" & T.Row).Value = .Range("K" & T.Row).Value + sh_source.Range("O" & J).Value
.Range("L" & T.Row).Value = .Range("L" & T.Row).Value + sh_source.Range("S" & J).Value
.Range("J" & T.Row).Value = sh_source.Range("M" & J).Value
.Range("M" & T.Row).Value = sh_source.Range("E" & J).Value
.Range("N" & T.Row).Value = sh_source.Range("F" & J).Value
.Range("O" & T.Row).Value = sh_source.Range("G" & J).Value

End With
End If
End If
Next
End If
If Not sh_source Is Nothing Then

End If

If Not sh_source Is Nothing Then
sh_distan.Activate
End If

If Not sh_source Is Nothing Then

For K = 2 To 180
If sh_source.Range("B" & K).Value <> "" Then

Set T = Worksheets("Données").Range("Q2:Q161").Find(sh_source.Range("B" & K).Value, , , xlWhole)
If Not T Is Nothing Then
With Worksheets("Données")

.Range("T" & T.Row).Value = .Range("T" & T.Row).Value + sh_source.Range("M" & K).Value
.Range("U" & T.Row).Value = .Range("U" & T.Row).Value + sh_source.Range("N" & K).Value
.Range("W" & T.Row).Value = .Range("W" & T.Row).Value + sh_source.Range("O" & K).Value
.Range("V" & T.Row).Value = .Range("V" & T.Row).Value + sh_source.Range("S" & K).Value

End With
End If
End If
Next
End If

If Not sh_source Is Nothing Then
End If

For z = 2 To 180
If sh_source.Range("B" & z).Value <> "" Then
Set V = Worksheets("Données").Range("A2:A1003").Find(sh_source.Range("B" & z).Value, , , xlWhole)
If Not V Is Nothing Then
With Worksheets("Données")

.Range("P" & V.Row).Value = .Range("P" & V.Row).Value + sh_source.Range("P" & z).Value
.Range("DE" & V.Row).Value = sh_source.Range("Q" & z).Value
.Range("DJ" & V.Row).Value = sh_source.Range("R" & z).Value
End With
End If
End If
Next

If Not sh_source Is Nothing Then
End If

TV = Range("Données!A1").CurrentRegion 'définit la variable TV
f = 1 'initialise la variable F
H = 1 'initialise la variable H
For I = 3 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la troisième)
If TV(I, 4) = "F" Then 'si la donnée ligne I colonne 4 de TV est égale à "F"
ReDim Preserve TF(1 To 2, 1 To f) 'redimensionne le tableau des femmes TF (deux lignes, F colonnes)
TF(1, f) = TV(I, 3) 'récupère le nom dans la première ligne
TF(2, f) = TV(I, 10) 'récupère le pointage dans la seconde ligne
f = f + 1 'incrémente F (rajoute une colonne au tableau des femmes TF)
End If 'fin de la condition
If TV(I, 4) = "H" Then 'si la donnée ligne I colonne 4 de TV est égale à "H"
ReDim Preserve TH(1 To 2, 1 To H) 'redimensionne le tableau des hommes TH (deux lignes, H colonnes)
TH(1, H) = TV(I, 3) 'récupère le nom dans la première ligne
TH(2, H) = TV(I, 10) 'récupère le pointage dans la seconde ligne
H = H + 1 'incrémente H (rajoute une colonne au tableau des hommes TH)
End If 'fin de la condition
Next I 'prochaine ligne de la boucle
If f > 1 Then 'condition : si F est supérieure a 1 (au moins une occurrence a été trouvée)
Range("Données!AE3").Resize(UBound(TF, 2), 2) = Application.Transpose(TF) 'renvoie dans la cellule AE2 redimensionnée le tableau TF transposé
End If 'fin de la condition
If H > 1 Then 'condition : si H est supérieure a 1 (au moins une occurrence a été trouvée)
Range("Données!AH3").Resize(UBound(TH, 2), 2) = Application.Transpose(TH) 'renvoie dans la cellule AH2 redimensionnée le tableau TH transposé
End If 'fin de la condition

Range("Données!AE2").CurrentRegion.Sort Range("Données!AF2"), xlDescending, Header:=xlYes 'trie le tableau des femmes

Range("Données!AH2").CurrentRegion.Sort Range("Données!AI2"), xlDescending, Header:=xlYes 'trie le tableau des hommes

TX = Range("Données!A1").CurrentRegion 'définit la variable TX
w = 1 'initialise la variable W
m = 1 'initialise la variable M
For q = 3 To UBound(TX, 1) 'boucle sur toutes les lignes Q du tableau des valeurs TX (en partant de la troisième)
If TX(q, 4) = "F" Then 'si la donnée ligne Q colonne 4 de TX est égale à "F"
ReDim Preserve TW(1 To 2, 1 To w) 'redimensionne le tableau des femmes TW (deux lignes, W colonnes)
TW(1, w) = TX(q, 3) 'récupère le nom dans la première ligne
TW(2, w) = TX(q, 7) 'récupère la moyennes dans la seconde ligne
w = w + 1 'incrémente W (rajoute une colonne au tableau des femmes TW)
End If 'fin de la condition
If TX(q, 4) = "H" Then 'si la donnée ligne Q colonne 4 de TX est égale à "H"
ReDim Preserve TM(1 To 2, 1 To m) 'redimensionne le tableau des hommes TM (deux lignes, M colonnes)
TM(1, m) = TX(q, 3) 'récupère le nom dans la première ligne
TM(2, m) = TX(q, 7) 'récupère la moyenne dans la seconde ligne
m = m + 1 'incrémente M (rajoute une colonne au tableau des hommes TM)
End If 'fin de la condition
Next q 'prochaine ligne de la boucle
If w > 1 Then 'condition : si W est supérieure a 1 (au moins une occurrence a été trouvée)
Range("Données!AK3").Resize(UBound(TW, 2), 2) = Application.Transpose(TW) 'renvoie dans la cellule AK2 redimensionnée le tableau TW transposé
End If 'fin de la condition
If m > 1 Then 'condition : si M est supérieure a 1 (au moins une occurrence a été trouvée)
Range("Données!AN3").Resize(UBound(TM, 2), 2) = Application.Transpose(TM) 'renvoie dans la cellule AN2 redimensionnée le tableau TM transposé
End If 'fin de la condition

Range("Données!AK2").CurrentRegion.Sort Range("Données!AL2"), xlDescending, Header:=xlYes 'trie le tableau des femmes

Range("Données!AN2").CurrentRegion.Sort Range("Données!AO2"), xlDescending, Header:=xlYes 'trie le tableau des hommes

TY = Range("Données!A1").CurrentRegion 'définit la variable TY
s = 1 'initialise la variable S
g = 1 'initialise la variable G
For R = 3 To UBound(TY, 1) 'boucle sur toutes les lignes R du tableau des valeurs TY (en partant de la troisième)
If TY(R, 4) = "F" Then 'si la donnée ligne R colonne 4 de TY est égale à "F"
ReDim Preserve TS(1 To 2, 1 To s) 'redimensionne le tableau des femmes TS (deux lignes, S colonnes)
TS(1, s) = TY(R, 3) 'récupère le nom dans la première ligne
TS(2, s) = TY(R, 12) 'récupère les 69 dans la seconde ligne
s = s + 1 'incrémente S (rajoute une colonne au tableau des femmes TS)
End If 'fin de la condition
If TY(R, 4) = "H" Then 'si la donnée ligne R colonne 4 de TY est égale à "H"
ReDim Preserve TG(1 To 2, 1 To g) 'redimensionne le tableau des hommes TG (deux lignes, G colonnes)
TG(1, g) = TY(R, 3) 'récupère le nom dans la première ligne
TG(2, g) = TY(R, 12) 'récupère les 69 dans la seconde ligne
g = g + 1 'incrémente G (rajoute une colonne au tableau des hommes TG)
End If 'fin de la condition
Next R 'prochaine ligne de la boucle
If s > 1 Then 'condition : si S est supérieure a 1 (au moins une occurrence a été trouvée)
Range("Données!AX3").Resize(UBound(TS, 2), 2) = Application.Transpose(TS) 'renvoie dans la cellule AX2 redimensionnée le tableau TS transposé
End If 'fin de la condition
If g > 1 Then 'condition : si G est supérieure a 1 (au moins une occurrence a été trouvée)
Range("Données!BB3").Resize(UBound(TG, 2), 2) = Application.Transpose(TG) 'renvoie dans la cellule BB2 redimensionnée le tableau TG transposé
End If 'fin de la condition

Range("Données!AX2").CurrentRegion.Sort Range("Données!AY2"), xlDescending, Header:=xlYes 'trie le tableau des femmes

Range("Données!BB2").CurrentRegion.Sort Range("Données!BC2"), xlDescending, Header:=xlYes 'trie le tableau des hommes

Application.ScreenUpdating = True

Call Transfert
Call HTHS
Call TrierRecap
Call FigerMoyennes

End Sub

Bonne journée.

Bonjour,

Le code soumis n'est qu'une partie sur dix du traitement.

Une suggestion pour tenter de comprendre où les délais sont les plus importants.

Mets un point d'arrêt (touche F9) sur chacune des lignes des 5 call au début. ( les lignes se colorent en brun )

Un autre sur la ligne : "If ActiveSheet.Name .........." juste en dessous.

Encore 4 autres sur les 4 call au bas. Ça te fait donc 10 points d'arrêt.

Garde la fenêtre VBE accessible et, montre en main, lance la macro > tu as sûrement un bouton dans une feuille pour lancer le tout.

La 1re macro s'exécutera et fera une pause sur le prochaine "Point d'arrêt" ... Évalue le temps de la première macro "Call AbsencesPayées" ...

Puis dans VBE, frappe F8 pour relancer l'exécution et évalue le temps de ce 2e segment > tu peux même prendre une note du temps pour chacune des étapes.

Encore là la touche F8 pour exécuter le 3e call ... etc, etc etc ... jusqu'à ce que tout le traitement soit complété.

Dès lors, tu auras ton 4 minutes par petits bouts ...

De ces 10 étapes, il restera à regarder les étapes les plus lentes pour tenter de les améliorer.

C'est ce que je ferais pour tenter de comprendre ce délai de 4 minutes.

Je ne peux pas faire mieux comme suggestion, car il manque le code des 9 call ... Même là, je ne suis pas sûr que mon restant de cerveau puisse tout évaluer en ne lisant que du code, surtout une telle quantité.

Si tu identifies des segments plus lents que les autres, l'on saura où regarder.

A+

ric

Bonjour Ric,

Encore merci pour l'intérêt que to porte à ce problème. Ça fait beaucoup de chose à évaluer pour un néophyte comme moi. Je regard le tout et te reviens dès que possible avec les réponses.

Merci et bonne soirée.

Bonjour Ric,

Désolé du retard, un peu occupé. Après avoir mis les "Call" et la ligne "If activeSheet.Name" en brun, lorsque je clique sur le bouton "Transférer" de mon système, ce bouton active la macro principale que je t'ai envoyée, le débogueur s'enclenche et met le premier Call (Absences payées) en jaune. J'ai supprimé le Call Absences payées pour voir ce qui se passerait, le débogueur s'enclenche sur le deuxième Call.

Désolé, je ne sais pas quoi faire pour que la macro s'active comme il se doit.

Comme je te l'ai mentionné plus tôt, tu n'as pas à perdre ton temps sur ce problème. Je peux très bien vivre avec un délai de 4 minutes par semaine étant donné que la partie se joue qu'une fois semaine.

Merci beaucoup pour l'intérêt porté à mon dossier et passe une belle journée.

Bonjour,

Je viens de me rappeler une autre méthode plus simple.

Je valide et te reviens.

ric

Bonjour,

J'ai de la difficulté avec mon autre méthode ...

En attendant ...

Si tu n'as qu'un seul écran : Mets ton classeur en fenêtré ainsi que la fenêtre VBE > les deux visibles > la fenêtre VBE peut ne montrer que 2 ou 3 lignes de code.

Si tu as 2 écrans, c'est plus simple.

Quand l'exécution s'arrête et la ligne devient jaune, note le temps entre le départ et cet arrêt.

Avec le focus sur la fenêtre VBE, frappe F8 à nouveau, l'exécution reprend jusqu'au prochain arrêt, note encore le délai entre la frappe de la touche F8 et ce nouvel arrêt.

Avec le focus sur la fenêtre VBE, à nouveau, frappe F8 à nouveau, l'exécution reprend jusqu'au prochain arrêt, note encore le délai entre la frappe de la touche F8 et ce nouvel arrêt.

Ainsi de suite jusqu'à la fin de la macro.

Je continue à déboguer mon autre méthode ...

ric

Bonjour golfeur01,

Je crois que cela va fonctionner ...

Ton code modifié pour compter les délais et dans le module 1 de ce fichier joint.

Sélectionne toute ta macro et mets là en commentaire. Peut-être travailler avec une copie de ton fichier !!!!

Colle celle modifiée et lance l'exécution normalement.

À la fin, il y aura un message donnant l'heure de chacune des fins d'étapes.

Il reste à prendre en note : soit avec un crayon ou encore ALT+Imprime écran et coller quelque part.

A+

ric

Bonjour Ric,

Désolé mais ça ne fonctionne pas. J'ai collé ta macro dans mon système à la place de ma macro et lorsque je clique sur le bouton Transférer une erreur de compilation, "Variable non définie", apparaît. Le débogage s'enclenche et plus rien ne bouge.

L'erreur est la suivante : Set sh_source = Worksheets("Abat.Neuf").

Juste avant j'ai enclencher le bouton avec ma macro et tout a fonctionné.

Pour être honnête et sans vouloir t'offusquer, je ne crois pas pouvoir continuer sur ce problème car je dois continuer à modifier le système qui est passé de 18 à 24 équipes. La nouvelle saison commence le 15 août et il reste beaucoup de modifications à effectuer. Comme mentionné dans mon message précédent, je peux très bien vivre avec les 4 minutes de délai causé par la macro.

Je te remercie beaucoup pour ton implication et ta patience pour tenter de régler le problème. Ce sera pour une autre fois, peut-être.

Bonne soirée.