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
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.
@+