Récapituler plusieurs fichiers dans un seul

Le 13/12/2014 à 19:52

Bonjour,

En faisant des recherches sur le Net, je suis arrivé à monter cette macro. Celle-ci permet de copier des fichiers Excel se trouvant dans un dossier et de coller le résultat dans un onglet d'un autre fichier. Mais...j'ai un problème que je n'arrive pas à comprendre (ça fait plusieurs jours que je me casse la tête avec ça ). Si dans le dossier où se trouve mes fichiers à copier j'ai 3 fichiers, ma macro en traite que deux, si j'en ai 5, elle en traite 4, etc..... C'est au niveau de la ligne 22 que j'ai une erreur après que par exemple 2 fichiers sur 3 ont été traités.

Est-ce que quelqu'un peut m'aider à comprendre pourquoi ma macro ne traite pas tous les fichiers puis se termine

Merci beaucoup d'avance.

Voici ma macro

==================================

01. Sub TraiteFichiersNew_12122014()

02. 'Application.ScreenUpdating = False

03. Dim CheminFichierACopier As String

04. Dim CheminFichierBackUp As String

05. Dim FichiersDansDossier As String

06. Dim MesFichiersACopier() As String

07. Dim DerniereLigneFichierACopier As String

08. Dim DerniereCelluleColonneARecap As String

'Chemin où sont enregistrés les fichiers des Cyto à copier

09. CheminFichierACopier = "H:\Cato\FileToCopy"

'Chemin pour déplacer le fichier qui vient d'être copié

10. CheminFichierBackUp = "H:\Cato\BackUp"

'Ajoute un \ à la fin du chemin si nécessaire

11. If Right(CheminFichierACopier, 1) <> "\" Then

12. CheminFichierACopier = CheminFichierACopier & "\"

13. End If

'Message si aucun fichier dans le dossier

14. FichiersDansDossier = Dir(CheminFichierACopier & FichiersDansDossier)

15. If FichiersDansDossier = "" Then

16. MsgBox "Pas de fichier à traiter. Veuillez enregistrer des fichiers!", vbCritical

17. Exit Sub

18. End If

'Traitement des fichiers à copier dans récap

19. Do While FichiersDansDossier <> ""

20. FichiersDansDossier = Dir()

21. 'Ouvre les fichiers de base et copie les données

22. Workbooks.Open Filename:=CheminFichierACopier & FichiersDansDossier

23. DerniereLigneFichierACopier = Range("A1").SpecialCells(xlCellTypeLastCell).Row

24. Range("A1:C" & DerniereLigneFichierACopier).Copy 'je copie les données du fichie qui vient d'être ouvert

25. Application.DisplayAlerts = False

26. ActiveWindow.Close

'Va dans le fichier de RECAP et colle les données

27. Windows("test macro.xlsm").Activate 'j'active le fichier dans lequel je veux coller les valeurs

28. Sheets("CollageCato").Select 'je sélectionne l'onglet où je veux coller les valeurs

29. ActiveSheet.Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteAll

30. ActiveSheet.Range("A" & Rows.Count).End(xlUp)(2).Select

31. Name CheminFichierACopier & FichiersDansDossier As CheminFichierBackUp & "\" & FichiersDansDossier

32. Loop

33. 'Application.ScreenUpdating = True

34. End Sub

==================================

Le 13/12/2014 à 21:14

Bonsoir

Tu extrait 1 fichier avant de commencer ta boucle Do While FichiersDansDossier <> "" ..... Loop quand tu fais

FichiersDansDossier = Dir(CheminFichierACopier & FichiersDansDossier)

mais celui-ci tu ne le traite pas

Dans ta boucle pour commencer tu extrait un autre fichier que tu traite etc .....

 FichiersDansDossier = Dir()

Donc tu as "perdu" un fichier

Modifies la macro

Sub TraiteFichiersNew_12122014()
'Application.ScreenUpdating = False
  Dim CheminFichierACopier As String
  Dim CheminFichierBackUp As String
  Dim FichiersDansDossier As String
  Dim MesFichiersACopier() As String
  Dim DerniereLigneFichierACopier As String
  Dim DerniereCelluleColonneARecap As String

  'Chemin où sont enregistrés les fichiers des Cyto à copier
  CheminFichierACopier = "H:\Cato\FileToCopy"
  'Chemin pour déplacer le fichier qui vient d'être copié
  CheminFichierBackUp = "H:\Cato\BackUp"

  'Ajoute un \ à la fin du chemin si nécessaire
  If Right(CheminFichierACopier, 1) <> "\" Then
    CheminFichierACopier = CheminFichierACopier & "\"
  End If
  'Message si aucun fichier dans le dossier
  FichiersDansDossier = Dir(CheminFichierACopier & FichiersDansDossier)
  If FichiersDansDossier = "" Then
    MsgBox "Pas de fichier à traiter. Veuillez enregistrer des fichiers!", vbCritical
    Exit Sub
  End If
  'Traitement des fichiers à copier dans récap
  Do While FichiersDansDossier <> ""
'    FichiersDansDossier = Dir()     ' ligne à déplacer avant le Loop
    'Ouvre les fichiers de base et copie les données
    Workbooks.Open Filename:=CheminFichierACopier & FichiersDansDossier
    DerniereLigneFichierACopier = Range("A1").SpecialCells(xlCellTypeLastCell).Row
    Range("A1:C" & DerniereLigneFichierACopier).Copy  'je copie les données du fichie qui vient d'être ouvert
    Application.DisplayAlerts = False
    ActiveWindow.Close
    'Va dans le fichier de RECAP et colle les données
    Windows("test macro.xlsm").Activate  'j'active le fichier dans lequel je veux coller les valeurs
    Sheets("CollageCato").Select  'je sélectionne l'onglet où je veux coller les valeurs
    ActiveSheet.Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteAll
    ActiveSheet.Range("A" & Rows.Count).End(xlUp)(2).Select
    Name CheminFichierACopier & FichiersDansDossier As CheminFichierBackUp & "\" & FichiersDansDossier
    FichiersDansDossier = Dir()
  Loop
  'Application.ScreenUpdating = True
End Sub
Le 14/12/2014 à 14:31

Bonjour,

Merci pour cette proposition. J'ai donc déplacer comme suit :

'Traitement des fichiers à copier dans récap

FichiersDansDossier = Dir()

Do While FichiersDansDossier <> ""

'Ouvre les fichiers de base et copie les données

Workbooks.Open Filename:=CheminFichierACopier & FichiersDansDossier

ActiveSheet.Range("A" & Rows.Count).End(xlUp)(2).Select

Name CheminFichierACopier & FichiersDansDossier As CheminFichierBackUp & "\" & FichiersDansDossier

FichiersDansDossier = Dir()

Loop

Mais je traite toujours que 2 fichiers sur 3 (ou 4 sur 5)

BDel

Le 14/12/2014 à 14:42

Bonjour

Presque ça

Sub TraiteFichiersNew_12122014()
'Application.ScreenUpdating = False
 Dim CheminFichierACopier As String
  Dim CheminFichierBackUp As String
  Dim FichiersDansDossier As String
  Dim MesFichiersACopier() As String
  Dim DerniereLigneFichierACopier As String
  Dim DerniereCelluleColonneARecap As String

  'Chemin où sont enregistrés les fichiers des Cyto à copier
 CheminFichierACopier = "H:\Cato\FileToCopy"
  'Chemin pour déplacer le fichier qui vient d'être copié
 CheminFichierBackUp = "H:\Cato\BackUp"

  'Ajoute un \ à la fin du chemin si nécessaire
 If Right(CheminFichierACopier, 1) <> "\" Then
    CheminFichierACopier = CheminFichierACopier & "\"
  End If
  'Message si aucun fichier dans le dossier
FichiersDansDossier = Dir(CheminFichierACopier & FichiersDansDossier)
  If FichiersDansDossier = "" Then
    MsgBox "Pas de fichier à traiter. Veuillez enregistrer des fichiers!", vbCritical
    Exit Sub
  End If
  'Traitement des fichiers à copier dans récap
 Do While FichiersDansDossier <> ""
    'Ouvre les fichiers de base et copie les données
   Workbooks.Open Filename:=CheminFichierACopier & FichiersDansDossier
    DerniereLigneFichierACopier = Range("A1").SpecialCells(xlCellTypeLastCell).Row
    Range("A1:C" & DerniereLigneFichierACopier).Copy  'je copie les données du fichie qui vient d'être ouvert
   Application.DisplayAlerts = False
    ActiveWindow.Close
    'Va dans le fichier de RECAP et colle les données
   Windows("test macro.xlsm").Activate  'j'active le fichier dans lequel je veux coller les valeurs
   Sheets("CollageCato").Select  'je sélectionne l'onglet où je veux coller les valeurs
   ActiveSheet.Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteAll
    ActiveSheet.Range("A" & Rows.Count).End(xlUp)(2).Select
    Name CheminFichierACopier & FichiersDansDossier As CheminFichierBackUp & "\" & FichiersDansDossier
   FichiersDansDossier = Dir()
  Loop
  'Application.ScreenUpdating = True
End Sub
Le 14/12/2014 à 17:56

Bonjour,

Merci Banzai64, ça fonctionne impeccable. Je voyais bien que la 1ère référence était le fichier qui à la fin n'était pas traité. Des heures là-dessus à essayer de comprendre.

Donc un grand merci et de belles fêtes

Bonne soirée

BDel

Rechercher des sujets similaires à "recapituler fichiers seul"