Optimisation Macro - Boucle

Bonjour,

Je souhaiterais pouvoir opérer une macro qui

• Onglet : Agences : Écrit « Testée » en colonne G à la ligne de la 1ère Agence NON VIDE entre ligne 42 et 61
• Lance mes /CALCULS (dans mon code)
• Supprime le mot « Testée »
• Puis réitère sous forme de boucle la même opération avec l’Agence NON VIDE suivante autant de fois qu’il y a d’Agences entre B42 et B61

Pour le moment, je répète ma macro 20 fois (Nbre de possibilités max entre B42-B61). J’ai conscience que ce n’est pas l’idéal; d'où ma demande :)

• /1/ Unique + Calcul
• /2/Unique + Calcul
• ....

Pouvez-vous m'aider s'il vous plait à générer la boucle ?

Je vous remercie par avance pour le temps que vous prendrez à comprendre mon problème.

Seb

Sub Macro2()

'/1/ Unique
    Sheets("Agences").Select
    Range("G42:G61").Select
    Selection.ClearContents
    Range("G42").Select
    ActiveCell.FormulaR1C1 = "Testée"

'/CALCUL/
'Mise à Jour TCD
Sheets("Agences").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh

' Copier Coller Valeur dans Conclusion
Dim DerligAG&, DerligDst&, i&
DerligAG = Sheets("Agences").Range("P" & Rows.Count).End(xlUp).Row

For i = 1 To DerligAG
    DerligDst = Sheets("Conclusion").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Etude").[A2] = UCase(Sheets("Agences").Range("Q" & i))
    Sheets("Conclusion").Range("A" & DerligDst & ":N" & DerligDst) = Sheets("Etude").[M5:Z5].Value
Next

'/2/ Unique
    Sheets("Agences").Select
    Range("G42:G61").Select
    Selection.ClearContents
    Range("G43").Select
    ActiveCell.FormulaR1C1 = "Testée"

'/CALCUL/
'Mise à Jour TCD
Sheets("Agences").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh

' Copier Coller Valeur dans Conclusion
For i = 1 To DerligAG
    DerligDst = Sheets("Conclusion").Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("Etude").[A2] = UCase(Sheets("Agences").Range("Q" & i))
    Sheets("Conclusion").Range("A" & DerligDst & ":N" & DerligDst) = Sheets("Etude").[M5:Z5].Value
Next

    Sheets("Agences").Select
    Range("G42:G61").Select
    Selection.ClearContents

End Sub

Voila qui semble répondre à la demande. Lancer par clic sur bouton "Test" la procédure est dans le Module5

C'est parfait ! merci beaucoup :)