Répéter une macro dans d'autres feuilles

Bonjour à tous,

J'ai à nouveau besoin de vos compétences !!

Je cherche à faire répéter une macro dans 6 feuilles différentes d'un classeur.

La macro va chercher les infos à copier dans un autre classeur selon le nom des feuilles du classeur de base.

J'ai déjà une solution pour répéter, mais elle le fait 6 fois dans la même feuille ... Du coup j'ai les mêmes infos copiées 6 fois dans la feuille active (ActiveSheet) de mon classeur de base ...

Avez-vous une solutions svp ?

Voilà mon code en exemple, pour 3 feuilles :

Sub Répéter_Macro_Dans_Feuilles_Différentes ()

'Nouveau nom pour le classeur1
    Classeur1 = ActiveWorkbook.Name

'Ouvrir classeur2
    MsgBox "Ouvrir le Classeur 2"

    Dim OpenClasseur2 As String

    OpenClasseur2 = Application.GetOpenFilename
    If Not OpenClasseur2 = "Faux" Then
    Application.Workbooks.Open (OpenClasseur2)
    Else
    Exit Sub
    End If
    Classeur2 = ActiveWorkbook.Name

'Ouvrir Classeur1
    Windows(Classeur1).Activate

'Et lancer la macro qui suit pour toutes les Feuilles du Classeur1
    For Each ws In ActiveWorkbook.Worksheets
    If ws.Name = "Feuil1" Or ws.Name = "Feuil2" Or ws.Name = "Feuil3" Then

'Nouveau nom pour la Feuille en cours
    page_en_cours = ActiveSheet.Name

    If page_en_cours = "Feuil1" Then
    ligne1 = 5
    page_en_cours = "F1"
    End If

    If page_en_cours = "Feuil2" Then
    ligne1 = 5
    page_en_cours = "F2"
    End If

    If page_en_cours = "Feuil3" Then
    ligne1 = 5
    page_en_cours = "F3"
    End If

'Sélectionne le Classeur2 et filtre les données pour page_en_cours
    Windows(Classeur2).Activate
    Sheets("Exemple").Select

    Dim DernLignClasseur2 As Long
    DernLignClasseur2 = Range("A" & Rows.Count).End(xlUp).Row

    'Filtre selon page_en_cours
    ActiveSheet.Range("A1:AB" & DernLignClasseur2).AutoFilter Field:=3, Criteria1:=page_en_cours
    'Filtre uniquement les éléments SOLDES
    ActiveSheet.Range("A1:AB" & DernLignClasseur2).AutoFilter Field:=21, Criteria1:="SOLDE"

'Copier/Coller les valeurs de la colonne 01
    Range("A2:A" & DernLignCLasseur2).Copy
    Windows(Classeur1).Activate
    Range("J65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End If
Next ws

End Sub

Re-bonjour,

Je me suis auto aidé

Je partage évidemment ma solution :

J'ai utilisé la fonction For afin de répéter les instructions :

Sub Répéter_Macro_Dans_Feuilles_Différentes ()

    For i = 1 to X    'Nombre de répétitions
'Instructions
'Afin que l'instruction reprenne dans la Feuille suivante j'ai ajouté :
    ActiveSheet.Next.Select

    Next    'Pour recommencer

End Sub

Et voilà ce que ça donne en entier pour 3 répétitions :

Sub Répéter_Macro_Dans_Feuilles_Différentes ()

    'Nouveau nom pour le classeur1
       Classeur1 = ActiveWorkbook.Name

    'Ouvrir classeur2
       MsgBox "Ouvrir le Classeur 2"

        Dim OpenClasseur2 As String

        OpenClasseur2 = Application.GetOpenFilename
        If Not OpenClasseur2 = "Faux" Then
        Application.Workbooks.Open (OpenClasseur2)
        Else
        Exit Sub
        End If
        Classeur2 = ActiveWorkbook.Name

    'Ouvrir Classeur1
       Windows(Classeur1).Activate

    'Et lancer la macro qui suit pour toutes les Feuilles ASTS
       For i = 1 To 3

    'Nouveau nom pour la Feuille en cours
       page_en_cours = ActiveSheet.Name

        If page_en_cours = "Feuil1" Then
        ligne1 = 5
        page_en_cours = "F1"
        End If

        If page_en_cours = "Feuil2" Then
        ligne1 = 5
        page_en_cours = "F2"
        End If

        If page_en_cours = "Feuil3" Then
        ligne1 = 5
        page_en_cours = "F3"
        End If

    'Sélectionne le Classeur2 et filtre les données pour page_en_cours
       Windows(Classeur2).Activate
        Sheets("Exemple").Select

        Dim DernLignClasseur2 As Long
        DernLignClasseur2 = Range("A" & Rows.Count).End(xlUp).Row

        'Filtre selon page_en_cours
       ActiveSheet.Range("A1:AB" & DernLignClasseur2).AutoFilter Field:=3, Criteria1:=page_en_cours
        'Filtre uniquement les éléments SOLDES
       ActiveSheet.Range("A1:AB" & DernLignClasseur2).AutoFilter Field:=21, Criteria1:="SOLDE"

    'Copier/Coller les valeurs de la colonne 01
       Range("A2:A" & DernLignCLasseur2).Copy
        Windows(Classeur1).Activate
        Range("J65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

    'Passer à la feuille suivante
       ActiveSheet.Next.Select

    Next

    End Sub

AzMiles