plusieurs macro en cascades

  • Initiateur de la discussion Initiateur de la discussion superbog
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

superbog

XLDnaute Occasionnel
Bonjour,

J'ai diverses macro, chacune fonctionnant sur une feuille différente. Est il possible de créer une macro globale qui les lancerait en cascade?

voici deux exemples de macros à "joindre"

Code:
Sub fact()

Dim i, DerLigBase, Lig As Integer
Dim dossier, sNomFeuille As String
Dim colFeuille As Collection
Dim rCelA As Range
Dim shAct As Worksheet
Dim FeuilleExist As Boolean

'Recherche de la dernière ligne
DerLigBase = Sheets("fact").Range("A999").End(xlUp).Row
Set colFeuille = New Collection

On Error Resume Next
'Boucle sur la plage de cellule
For Each rCelA In Sheets("fact").Range(Cells(2, 1), Cells(DerLigBase, 1))
    colFeuille.Add rCelA, CStr(rCelA)
Next rCelA

'Recherche de la ligne et tri dans chaque feuille
For i = 2 To DerLigBase
    dossier = Cells(i, 1).Text
    Lig = Sheets(dossier).Range("U999").End(xlUp).Row
           
           'Copie les valeurs si non barrées
With Sheets("fact").Cells(i, "B").Resize(, 7)
  If Not .Cells(1).Font.Strikethrough Then '1ère valeur non barrée
    Worksheets(dossier).Cells(Lig + 1, "U").Resize(, 7) = .Value
    .Font.Strikethrough = True
  End If
End With
Next i

MsgBox "opération effectuée"

End Sub

Sub HR()

Dim i, DerLigBase, Lig As Integer
Dim dossier, sNomFeuille As String
Dim colFeuille As Collection
Dim rCelA As Range
Dim shAct As Worksheet
Dim FeuilleExist As Boolean

'Recherche de la dernière ligne
DerLigBase = Sheets("HR").Range("A999").End(xlUp).Row
Set colFeuille = New Collection

On Error Resume Next
'Boucle sur la plage de cellule
For Each rCelA In Sheets("fact").Range(Cells(2, 1), Cells(DerLigBase, 1))
    colFeuille.Add rCelA, CStr(rCelA)
Next rCelA

'Recherche de la ligne et tri dans chaque feuille
For i = 2 To DerLigBase
    dossier = Cells(i, 1).Text
    Lig = Sheets(dossier).Range("AA999").End(xlUp).Row
   
'Copie les valeurs si non barrées
With Sheets("HR").Cells(i, "B").Resize(, 7)
  If Not .Cells(1).Font.Strikethrough Then '1ère valeur non barrée
    Worksheets(dossier).Cells(Lig + 1, "AA").Resize(, 7) = .Value
    .Font.Strikethrough = True
  End If
End With
Next i

MsgBox "opération effectuée"

End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
734
Réponses
4
Affichages
754
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
1 K
Réponses
3
Affichages
881
Réponses
2
Affichages
771
Retour