Exécuter la même macro sur plusieurs feuilles en auto

jeuno

XLDnaute Nouveau
Bonjour à tous,

J'ai un souci, après plusieurs essais je n'arrive pas à trouver la bonne formule pour ...
Faire fonctionner la même macro sur toutes mes feuilles, une après l'autre !
Macro qui fonctionne très bien sur la feuille que je veux


Voici ma macro (exemple sur la feuille nommée "3") :

Sub AlgoCalculer()
Sheets("3").Select

'Call Effacer1 Macro
Range("D13:D200").Select
ActiveWindow.SmallScroll Down:=-42
Selection.ClearContents
Range("I14").Select

'Call Sub TrierLesEspacesEntreLes1()
Range("D200:D13").ClearContents
Dim cel As Range
For Each cel In Range("B2:B1650")
If cel = 0 Then i = i + 1
If cel = 1 Then
Range("D" & Range("D65535").End(xlUp).Row + 1) = i
i = 0
End If
Next cel

End Sub

Merci pour votre aide
JEUNO
 

Papou-net

XLDnaute Barbatruc
Re : Exécuter la même macro sur plusieurs feuilles en auto

Bonjour jeuno,

Essaie comme ceci:

Code:
Sub AlgoCalculer()
Dim sh As Sheets, cel As Range

For Each sh In ThisWorkbook.Sheets
  'Call Effacer1 Macro
  .Range("D13200").Select
  ActiveWindow.SmallScroll Down:=-42
  Selection.ClearContents
  .Range("I14").Select
  'Call Sub TrierLesEspacesEntreLes1()
  .Range("D20013").ClearContents
  For Each cel In .Range("B2:B1650")
    If cel = 0 Then i = i + 1
    If cel = 1 Then
      .Range("D" & Range("D65535").End(xlUp).Row + 1) = i
      i = 0
    End If
  Next cel
Next sh
End Sub
Cordialement.
 

jeuno

XLDnaute Nouveau
Re : Exécuter la même macro sur plusieurs feuilles en auto

Bonjour Papou-net,

La macro ne fonctionne pas, elle Buge !

J'ai peut-être oublié de dire, si ça peut aider
qu'il fallait que la même macro fonctionne sur les feuilles de 1 à 49.
(Les feuilles sont identiques mais seul les chiffres sont différents sur les feuilles)


Voila .. merci Beaucoup.
 

Papou-net

XLDnaute Barbatruc
Re : Exécuter la même macro sur plusieurs feuilles en auto

RE:

J'ai peut-être oublié de dire, si ça peut aider
Bien sûr que ça peut aider! Mais ce qui pourrait aider davantage encore ce serait de joindre une copie allégée de ton fichier, et surtout sans données confidentielles. Sans voir la structure du classeur, pas de réponse précise au problème.

A +

Cordialement.
 

jeuno

XLDnaute Nouveau
Re : Exécuter la même macro sur plusieurs feuilles en auto

J'ai réussi à réduire mon fichier ... Ouf !
Il n'y aura que 4 feuilles

Voici mon fichier.

Le bouton est sur la feuille Algorithme
et le nom de la macro est : AlgoCalculer

Merci pour ton aide
 

Pièces jointes

  • test.xlsm
    165 KB · Affichages: 33
  • test.xlsm
    165 KB · Affichages: 32
Dernière édition:

Papou-net

XLDnaute Barbatruc
Re : Exécuter la même macro sur plusieurs feuilles en auto

RE:

Voici comment je vois les choses (si j'ai bien compris):

Code:
Sub AlgoCalculer()
Dim cel As Range

For Each sh In ThisWorkbook.Sheets
  'Call Effacer1 Macro
  If sh.CodeName <> "Feuil2" And sh.CodeName <> "Feuil3" Then
    sh.Range("D13:D200").ClearContents
    ActiveWindow.SmallScroll Down:=-42
    'Call Sub TrierLesEspacesEntreLes1()
    For Each cel In sh.Range("B2:B1650")
      If cel.Value = 0 Then i = i + 1
      If cel.Value = 1 Then
        sh.Range("D" & sh.Range("D65535").End(xlUp).Row + 1) = i
        i = 0
      End If
    Next cel
  End If
Next sh
End Sub
Je te joins une copie pour vérification mais pour moi ça semble fonctionner. En tout cas, il n'y a plus d'erreur.

J'en ai profité pour restructurer et simplifier le code.

Cordialement.
 

Pièces jointes

  • Copie de test.xlsm
    159.9 KB · Affichages: 32
  • Copie de test.xlsm
    159.9 KB · Affichages: 37

Discussions similaires

Statistiques des forums

Discussions
311 740
Messages
2 082 049
Membres
101 882
dernier inscrit
XaK_