Macro pour parcourir différents fichiers

[Raph82]

Bonjour à tous,

Je vous sollicite à nouveau pour un problème sur une macro que j'ai créé :
mon fichier a pour objectif de regrouper des données contenues dans un nombre inconnu d'autre fichiers (qui ont tous la même forme).
J'ai donc créé la macro suivante qui fonctionne sur mon pc perso avec Excel 2003 mais qui ne fonctionne pas sur mon pc pro avec Excel 2010.

Sub synthese_achats()

chemin = ThisWorkbook.Worksheets(2).Range("a2").Value
Fichier = Dir(chemin & "*.xls")
Dim l As Integer

'Copier les demandes achats
Do While Fichier <> ""
Workbooks.Open (chemin & Fichier)
ActiveWorkbook.Worksheets("Demandes").Cells(1, 1).Select
Selection.CurrentRegion.Select
Selection.Offset(1, 1).Select
Selection.Copy
Workbooks("Synthèse achats.xls").Activate
ActiveWorkbook.Worksheets("Synthese").Cells(1, 1).Select
ActiveWorkbook.Worksheets("Synthese").Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial

If Fichier <> "Synthèse achats.xls" Then
Workbooks(Fichier).Close
End If

Exit Do
Loop

End Sub

Le problème est que la macro n'ouvre que le premier fichier et ne loop pas sur les fichiers suivants. Ma synthèse n'est donc pas du tout complète !

Je n'ai pas trouvé qu'est-ce qui pourrait faire que la macro fonctionne ou pas selon les versions d'Excel.

Je vous joins mon fichier de synthèse et un exemple des fichiers à parcourir.

En vous remerciant par avance de votre aide.

 

[Pierrot93]

Re : Macro pour parcourir différents fichiers

Bonjour,

pas ouvert tes fichiers, mais enlève peut être le "exit do" et avant le "loop" initialise kle fichier suivant :

fichier = Dir
Loop

bonne journée
@+

 

[Raph82]

Re : Macro pour parcourir différents fichiers

Bonjour,

Merci de votre réponse. J'ai fait les modifications. La macro fonctionne toujours sous Excel 2003 mais ne fonctionne toujours pas sur mon pc pro sous Excel 2010.

Avez-vous d'autres pistes ?

 

[Raph82]

Re : Macro pour parcourir différents fichiers

Pour info, ma macro est donc la suivante :
Sub synthese_achats()

chemin = ThisWorkbook.Worksheets(2).Range("a2").Value
fichier = Dir(chemin & "*.xls")
Dim l As Integer

'Copier les demandes achats
Do While fichier <> ""
If fichier <> "Synthèse achats.xls" Then
Workbooks.Open (chemin & fichier)
ActiveWorkbook.Worksheets("Demandes").Cells(1, 1).Select
Selection.CurrentRegion.Select
Selection.Offset(1, 1).Select
Selection.Copy
Workbooks("Synthèse achats.xls").Activate
ActiveWorkbook.Worksheets("Synthese").Cells(1, 1).Select
ActiveWorkbook.Worksheets("Synthese").Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
Selection.PasteSpecial
End If

If fichier <> "Synthèse achats.xls" Then
Workbooks(fichier).Close
End If
fichier = Dir
Loop

End Sub