Boucle sur tous les classeurs ouverts

Grace à fred2406, j'ai un super code qui me permet d'avoir x classeurs contenant 1 seule feuille ouvert.

Je cherche à faire une boucle sur tous les classeurs ouverts sauf mon classeur de travail (envoi.xslm) afin copier la page de cellules "A1:H50" dans une unique feuille de mon classeur (feuil3) ou une nouvelle feuille

voici mon code

Sub BouclePlagesHeader()
    'Définit une variable qui va représenter un classeur
    Dim Wb As Workbook
    'Définit une variable qui va représenter une feuille de calcul
    Dim Ws As Worksheet
    'Définit une variable qui va représenter une cellule
    Dim Cell As Range
    'définit une variable qui repésente la plage à copier
    Dim plage As Range

    plage = [A1:H50]

    'Boucle sur chaque classeur ouvert
    For Each Wb In Application.Workbooks
        'Boucle sur chaque feuille de chaque classeur
        For Each Ws In Wb.Worksheets
            'Boucle sur chaque cellule de la plage A1
            For Each Cell In Ws.Range("A1")
                'Si la cellule contient la valeur [Header], copie de la plage A1:H50
                If Cell.Value = [Header] Then plage.copy...................
                Next Cell
        Next Ws
    Next Wb
End Sub

je ne sais pas comment finir pour indiquer que je veux copier la plage vers la feuille de mon classeur de travail en collant 5 lignes en dessous de la dernière cellule pleine

si quelqu'un pouvait jeter un oeil

D'avance je vous remercie pour votre aide et votre disponibilité

Bonjour Eole, bonjour le forum,

Peut-être comme ça :

Sub BouclePlagesHeader()
Dim CT As Workbook 'déclare la variable CT (Classeur de Travail)
Dim OT As Worksheet 'déclare la variable OT (Onglet de Travail)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim C As Workbook 'déclare la variable C (Classeurs)
Dim O As Worksheet 'déclare la variable O (Onglets)

Set CT = Workbooks("envoi.xslm") 'définit le classeur de travail CT
Set OT = CT.Sheets("Feuil3") 'définit l'onglet de travail OT
For Each C In Application.Workbooks 'boucle 1 : sur tous les classeurs ouverts
    If Not C.Name = CT.Name Then 'condition : si le classeur n'est pas CT
        For Each O In C.Worksheets 'Boucle 2 sur tous les onglets O du classeur C
            If O.Range("A1").Value = "Header" Then 'condition 2 : si la valeur de A1  de l'onglet O est égale à "Header" (pas besoin de boucle pour une seule cellule !)
                'définit la cellule de destination DEST (A1, si A1 est vide, sinon la cinquième cellule vide de la colonne A de l'onglet OT)
                Set DEST = IIf(OT.Range("A1").Value = "", OT.Range("A1"), OT.Range("A" & Application.Rows.Count).End(xlUp).Offset(5, 0))
                O.Range("A1:H50").Copy DEST 'copy la plage A1:H50 de l'ongelt O et la colle dans DEST
            End If 'fin de la condition 2
        Next O 'prochain onglet de la boucle 2
    End If 'fin de la condition 1
Next C 'prochain classeur de la boucle 1
End Sub

Bonjour le forum

Bonjour ThauThème et merci pour ton aide

j'ai une erreur d'exécution "l'indice n'appartient pas à la sélection"

j'ai mis un dossier zip

- la première commande renomme les fichiers et créée les fichiers contenus dans chaque sous répertoire avec le nom du sous

répertoire et laisse tous les classeurs ouvert

• la deuxième c'est la tienne il y a un message d'erreur
• la dernière referme tout

merci pour ton aide et pour le temps que tu m'accorde

Bonsoir le forum

j'ai trouvé pourquoi j'avais le message d'erreur "l'indice n'appartient pas à la sélection"

Set CT = Workbooks("envoi.xlsm") 'définit le classeur de travail CT

était orthographié

Set CT = Workbooks("envoi.xslm") 'définit le classeur de travail CT

par contre je n'ai aucun résultat

Re,

Désolé pour l'orthographe (il m'arrive souvent d'inverser des lettres...)

Tu dis que rien ne se passe mais je ne peux pas tester sans les fichiers qui vont bien.

Le zip contient des dossiers (que je ne peux donc pas ouvrir dans excel) et chaque dossier toujours le même fichier texte vide fiber_info_otdr.txt. Je ne peux pas tester avec ça...

Bonsoir le forum,

Bonsoir ThauThème

excuse moi je pensais avoir mis la bonne version du fichier "envoi" dans le zip

Explication du zip

Mettre dans un dossiers tous les dossiers du zip

Oui tous les dossiers du zip contiennent le même

fichier, mais pas les mêmes données

Lancer le bouton 1, aller chercher le dossier et tous les fichiers de chaque sous

dossier vont se renommer avec le nom des sous dossier et se créer

également en *.xlsx (ils restent tous ouvert)

Ce que je cherche à faire c'est de copier la plage de cellule

"A1:H50" de tous les fichiers ouverts dans la feuille 3

du classeur "envoi"

merci pour ton aide

Toutes mes excuses j'ai envoyé un zip avec les fichiers vides

en voici un autre celui-ci avec tous ce qu'il faut

Bonjour Eole, bonjour le forum,

Remplace la ligne de code :

If O.Range("A1").Value = "Header"

par :

If O.Range("A1").Value = "[Header]"

Bonsoir le forum

Bonsoir Thauthème

Super impec ça fonctionne

Un grand merci pour ton aide, ta patience et ta disponibilité