VBA - Copier/coller formule puis valeur

J'ai chronométré sur le fichier complet :

A l'ouverture du fichier : 75 lignes "RETARD" donnent 12 secondes.

Et lors d'un changement de congés pour la ressource qui est la plus "citée", soit 88 lignes j'obtiens environ 21 secondes.

J'ai intégré le countif, et modifié les avancements de la barre pour que cela s'adapte quelque soit le nombre retourné par countif.

Dans le fichier ci-joint j'ai essayé de calquer au langage de la macro à l'ouverture du fichier pour les mots "retard", notamment au niveau de la range de comptage.

Je m'interroge quant à l'incorporation à la macro complète : où placer les lignes de code de la barre d'avancement ? et également comment faire pour que cette barre de progression se déclenche pour 2 événements ? :

1) ouverture du fichier et calcul de tous les "RETARD" puis application formule

2) modification des dispos d'une personne, dans ce cas le "RETARD" devient le "C"

Bonjour,

J’ai effectué une adaptation de la procédure de la feuille « Congés » pour intégrer une barre de progression. Je te laisse le loisir d’effectuer les tests sur ton fichier.

Tu pourras l’adapter si tu veux l’appliquer également à l’ouverture du classeur pour les retards.

Cordialement.

Bonsoir Gyrus,

Merci pour ton implication

J'ai testé et j'ai compris que l'occurrence avait une importance d'après ton code.

En testant sur une ressource qui finalement avait 177 fois son nom de cité, j'ai vu que l'avancement en % atteignait 177% et pour une qui n'en avait que 10, le compteur ne décolle pas et la fenêtre se ferme rapidement.

                    Pas = Totaloccurence / Totaloccurence
                    Progression = Progression + Pas
                    UserForm1.Bar.Width = (Progression + Pas) / Totaloccurence * 100 * 2
                    UserForm1.Text.Caption = "Progression " & Int((Progression + Pas) / Totaloccurence * 100) & "%"
                    DoEvents

En comprenant bien ton code, j'ai pu via le code ci-dessus, faire que l'avancement soit tjrs bon quelque soit le nombre d'occurences.

L'affichage fonctionnant mieux sur les grandes occurences que sur les très faibles (inférieure à 10, l'affichage est rapide ce qui est normal mais l'affichage indique en bout de course "125%" avant de disparaître ^^).

Je décroche pour ce soir mais demain j'essaye de transcrire cette merveille pour les "RETARD".

Merci encore gyrus !

Bonne soirée.

Bonsoir Gyrus,

Je crois que j'y suis... et grâce à toi ! Merci énormément.

Pour le code à l'ouverture voilà ce que cela donne :

Option Explicit
Sub Workbook_Open()
'MACRO : Pour chaque plage contenant "RETARD" réalise le copier/coller de la formule permettant la ventilation des heures
Dim Plage As Range, Cel As Range, Totaloccurence As Integer, Progression As Integer, Pas As Double
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    With Worksheets("Liste_projets")
    'on fixe la zone de travail à R3 à dernière non vide en R
        Set Plage = .Range(.Range("R3"), .Cells(.Rows.Count, "R").End(xlUp))
    'on calcule le nombre total d'occurences de RETARD sur la plage
        Totaloccurence = Application.WorksheetFunction.CountIf(Plage, "RETARD")
        UserForm1.Show 0
        Progression = 0

    'pour chaque cellule dans la plage
        For Each Cel In Plage

            Pas = Totaloccurence / Totaloccurence 'détermination du pas
            UserForm1.Bar.Width = (Progression + Pas) / Totaloccurence * 100 * 2 'avancement de la barre
            UserForm1.Text.Caption = "Progression " & Int((Progression + Pas) / Totaloccurence * 100) & "%" 'avancement du texte de la barre
            DoEvents 'réaliser l'évènement

            If Cel = "RETARD" Then 'si la cellule contient "RETARD" alors
                Progression = Progression + Pas 'incrémentation de progression
                .Range("DP3:HG3").Copy 'copie la range contenant les formules
                .Cells(Cel.Row, "DP").Resize(, 96).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                .Cells(Cel.Row, "DP").Resize(, 96).Calculate
                .Cells(Cel.Row, "DP").Resize(, 96).Copy
                .Cells(Cel.Row, "DP").Resize(, 96).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End If 'fin du test
        Next Cel 'cellule suivante

    End With
    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Unload UserForm1 'fermeture de l'userform
End Sub

Vraiment super... merci beaucoup !!!

Résolu !