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

[jeuno]

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("D13200").Select
ActiveWindow.SmallScroll Down:=-42
Selection.ClearContents
Range("I14").Select

'Call Sub TrierLesEspacesEntreLes1()
Range("D20013").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]

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

Bonjour jeuno,

Essaie comme ceci:

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]

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

Merci j'essaye de suite ...

 

[jeuno]

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]

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]

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

J'ai créé un fichier allégé mais il fait encore 4 mo !!

Le site me le refuse ... !

 

[Papou-net]

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

J'ai créé un fichier allégé mais il fait encore 4 mo !!

Le site me le refuse ... !

Allège, allège.

Tu peux notamment supprimer des feuilles: les 49 onglets ne sont pas nécessaires pour comprendre le problème.

A +

Cordialement.

 

[jeuno]

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

 

[Papou-net]

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

RE:

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

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.

 

[jeuno]

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

Merci beaucoup (désolé j'ai bossé à fond pendant 2 jours !!)

Je vais faire l'essai ...