Copie automatique d'onglets

Bonjour à tous

J'ai plusieurs fichiers dans un répertoire défini. Dans ce répertoire, il y a également un fichier "synthèse" (ici appelé TDB & Landing) qui doit récupérer les onglets commençant par "SUivi" dans tous les fichiers que comporte le répertoire

J'utilise cette macro déjà dans un autre dossier avec d'autres fichiers et celle-ci fonctionne très bien.

Le problème c'est que pour ce nouveau répertoire et ce fichier synthèse (TDB & Landing), la macro ne focntionne pas puisqu'elle récupère uniquement l'onglet "Suivi" de 2 fichiers alors même que le répertoire en question contient 9 fichiers

Voici le code utilisé :

Sub ListingFichiers()

    'Effacer les cellules des onglets de suivi des CC
    Dim o As Object
   For Each o In Worksheets
        ' noms d'onglets non concernés lister
        If o.Name <> "TDB" And o.Name <> "TAUX" And o.Name <> "Graphic Analysis" And o.Name <> "ADMIN" And o.Name <> "Graphic Data" And o.Name <> "DATA TABLES" And o.Name <> "DATA TABLES CROSS DOMAIN" Then
            ' plage de cellules préciser
            o.Range("A1:AJ500").ClearContents
       End If
    Next

Application.DisplayAlerts = False
Dim Rep As String, Fichier As String

Rep = Workbooks(ActiveWorkbook.Name).Path & "\"
Fichier = Dir(Rep)
Do While Fichier <> ""
    If Fichier <> ThisWorkbook.Name Then
        On Error Resume Next
        Workbooks(Fichier).Activate
        If Err <> 0 Then
        Workbooks.Open Filename:=Rep & Fichier
        On Error GoTo 0
        End If
        For Each ws In ActiveWorkbook.Sheets
            If ws.Name Like "Suivi*" Then
                For Each wk In Workbooks("TDB & Landing.xlsm").Sheets
                i = 1 + i
                    If ws.Name = wk.Name Then
                        ws.Cells.Copy
                        wk.[A1].PasteSpecial
                        Else
                    If i = Workbooks("TDB & Landing.xlsm").Sheets.Count Then
                            ws.Copy After:=Workbooks("TDB & Landing.xlsm").Sheets(1)
                    End If
                    End If
                Next wk
            End If
        Next ws
        Application.DisplayAlerts = False
        Workbooks(Fichier).Close False
        Application.DisplayAlerts = True
        Fichier = Dir
        Else
        Fichier = Dir
    End If
Loop

For Each wksh In ThisWorkbook.Worksheets
If wksh.Name Like "Suivi*" Then
    wksh.Cells.Copy
    wksh.Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If
Next wksh

End Sub

Est ce que vous avez une idée du problème? Je n'ai aucune erreur lors du lancement de la macro

Mille merci pour votre précieuse aide

Très bonne journée

Bonjour,

voici un exemple simplifié, les onglets sont copiés dans le fichier "TDB & Landing"

j'ai supposé que la macro allait dans le fichier "TDB & Landing"

Sub ListingFichiers2()
Application.DisplayAlerts = False
Dim Rep As String, Fichier As String, wk As Workbook

Set wk1 = ThisWorkbook
Rep = wk1.Path & "\"
Fichier = Dir(Rep)

Do While Fichier <> ""
        If Fichier <> wk1.Name Then
          Workbooks.Open Filename:=Rep & Fichier
        End If

        For Each ws In ActiveWorkbook.Sheets
            If ws.Name Like "Suivi*" Then
                ws.Copy After:=wk1.Sheets(wk1.Sheets.Count)
            End If
        Next ws

        Workbooks(Fichier).Close False
        Fichier = Dir
Loop
End Sub

Bonjour

merci pour le nouveau code

Après avoir testé, j'ai une erreur sur cette ligne:

 Workbooks.Open Filename:=Rep & Fichier

Sais tu d'où cela peut venir?

Merci pour la réponse et très bonne journée

Re-bonjour tout le monde

Rectification, en fait le code marche (ne se bloque pas) mais une fois le traitement terminé, il ferme le fichier et celui-ci ne contient aucune donnée...

Je ne sais pas quoi faire

Merci pour votre aide

Bonjour,

pouvez-vous exécuter les code en mode pas à pas (F8) et vérifier si les fichiers sont bien ouvert et qu'il contiennent un onglet "suivi"

Hello

Je ne comprend plus rien, quand je fais avec F8 le pas-à-pas, cela fonctionne, les fichiers s'ouvrent puis se copient dans le fichier de destination

Mais quand je lance la macro classiquement, les fichiers s'ouvrent mais ne se copient pas dans le fichier de destination

Savez vous d'ou peut venir la différence entre le lancement via macro et le lancement via F8?

Merci et désolé d'être un boulet

Bonjour,

pouvez-vous faire une autre essai sans la ligne suivante

Application.DisplayAlerts = False

des fois qu'il vous indiquerait un message d'erreur

merci de votre patience

je viens d'essayer et en fait j'ai ce message qui fait que de revenir (genre plus de 300 fois je pense):

Savez vous comment faire pour passer outre?, (et plus généralement, d'où vient ce problème?)?

Merci par avance et très bonne journée

ce nom doit faire référence a une plage nommée "aa" sur le fichier ouvert,

et excel dit que se nom existe déjà sur le fichier destination.

si vous pouvez supprimer ce nom sur le fichier de destination (fichier contenant la macro), et refaire un essai.

@+