Regroupement de fichiers Excel

Crysta17 Messages postés 19 Statut Membre -  
Crysta17 Messages postés 19 Statut Membre -
Bonjour à tous,

Je suis actuellement en stage et ma mission est de regrouper plusieurs fichiers Excel dans un seul. Je m'explique. J'ai une vingtaine de fichiers Excel contenant chacun plusieurs onglets. Chaque onglet possède un tableau de la même structure. Je dois regrouper dans un fichier récapitulatif tous les tableaux de tous les fichiers dans un seul grand tableau commun.
Après de nombreuses recherches et à force de persévérance je suis arrivée au code suivant :
Sub CreationSynthese()
Dim Ws As Worksheet
Dim collectivite As Range

' Parcours de tous les fichiers
' -----------------------------
ChDir "I:\Volumes de données" 'Chemin d'accès au répértoire
LesFichiers = Dir("I:\Volumes de données\*.xlsx") 'Récupère le premier fichier
While Len(LesFichiers) > 0 'Tant que le nom du ficher a plus de 0 caractères
Workbooks.Open LesFichiers
For Each Ws In ActiveWorkbook
collectivite = Range("A1").Value
AvantDerniereLigne = ActiveSheet.UsedRange.Rows.Count
Range("A15:W" & AvantDerniereLigne).Copy
Workbooks("Récapitulatif.xlsm").Activate 'Activation du fichier récap
DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
Range("A" & DebutNomFichier).Select
ActiveSheet.Paste
Range("A2:A" & ActiveSheet.UsedRange.Rows.Count) = collectivite
Workbooks(LesFichiers).Close
LesFichiers = Dir 'Passage au fichier suivant
Next Ws
Wend

End Sub

Néanmoins ce programme ne marche pas, et je suis totalement à cours d'idée ! Quelqu'un aurait-il la gentillesse de bien vouloir essayer de m'aider ? :)

7 réponses

  1.
    Polux31 Messages postés 7219 Statut Membre 1 204
     
    Bonjour,

    Le 
    Next Ws
    est mal placé...

    Il faut le mettre juste avant 
    Workbooks(LesFichiers).Close

    0
  2. Crysta17 Messages postés 19 Statut Membre
     
    Je te remercie de ta réponse si rapide.
    Après application de ta solution le débogueur m'indique :

    For Each Ws In ActiveWorkbook -> Propriété ou méthode non gérée par cet objet

    Aurais-tu une idée ?

    Encore merci !
    0
  3. Polux31 Messages postés 7219 Statut Membre 1 204
     
    Essaie en ajoutant 

    Dim Wk as Workbook
Dim Ws

'...

Set WK = Workbooks.Open(LesFichiers)
For Each Ws In Wk.Worksheets
'.....


    «Ce que l'on conçoit bien s'énonce clairement, Et les mots pour le dire arrivent aisément.»
    Nicolas Boileau
    0
  4. Crysta17 Messages postés 19 Statut Membre
     
    C'est mieux ! Mon programme accepte ma boucle For Each avec ta solution.

    Néanmoins lors de l'exécution, ma macro me copie en boucle infinie les entêtes de mes tableaux (qui sont tous les mêmes), et non leurs contenus...

    Au moins quelque chose s'exécute, j'ai bon espoir ! ;)
    Merci à toi !
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Polux31 Messages postés 7219 Statut Membre 1 204
     
    Remplace 
    AvantDerniereLigne = ActiveSheet.UsedRange.Rows.Count
    par 
    AvantDerniereLigne = ws.UsedRange.Rows.Count


    Au début de ta Sub, ajoute 
    Dim WkRecap As Workbook
Dim WsRecap As Worksheet
Dim DerLigRecap as long

Set WkRecap = ThisWorkbook
Set WsRecap = WkRecap.Worksheets(1)


    et modifie le code suivant dans ta boucle: 
    AvantDerniereLigne = ActiveSheet.UsedRange.Rows.Count 
 Range("A15:W" & AvantDerniereLigne).Copy 
 Workbooks("Récapitulatif.xlsm").Activate 'Activation du fichier récap 
 DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1 
 Range("A" & DebutNomFichier).Select 
 ActiveSheet.Paste 
 Range("A2:A" & ActiveSheet.UsedRange.Rows.Count) = collectivite 
 Workbooks(LesFichiers).Close


    Par 
    DerLigRecap = WsRecap.UsedRange.Rows.Count + 1
Ws.Range("A15:W" & AvantDerniereLigne).Copy WsRecap.Range("A" & DerLigRecap)
WsRecap.Range("A2:A" & WsRecap.UsedRange.Rows.Count) = collectivite
Wk.Close
Set Wk = Nothing


    «Ce que l'on conçoit bien s'énonce clairement, Et les mots pour le dire arrivent aisément.»
    Nicolas Boileau
    0
  7. Crysta17 Messages postés 19 Statut Membre
     
    J'ai remplacé mon code par les éléments que tu m'as donné. Et nouvelle erreur, qui à mon avis n'a absolument rien à voir avec ta solution.

    Erreur D'exécution 1004, fichier untel.xls introuvable.

    Pourtant ce fichier est bien présent dans mon dossier. J'ai tenté de le supprimer pour essayer ta solution sur les autres, mais toujours la même erreur, avec un autre fichier...

    C'est vraiment à y perdre la tête !...

    Merci de prendre sur ton temps pour me répondre, c'est vraiment gentil de ta part.

    Crysta
    0
    1. Polux31 Messages postés 7219 Statut Membre 1 204
       
      Voilà la fonction que j'utilise pour récupérer tous les fichiers d'un répertoire connu: 

      Public Sub RecupFichiers(Byval Chemin As String, Byref mTab())
Dim Fichier As String
Dim i as long
 
    Fichier = Dir(Chemin & "*.xls*")
 
    Do While Len(Fichier) > 0
        Redim Preserve mTab(i)
        mTab(i) = Chemin & Fichier
        i = i + 1
        Fichier = Dir()
    Loop

End Sub


      Je passe le chemin du dossier et un tableau par référence que je vais utiliser pour boucler sur mes fichiers.

      Ce qui donne pour ton cas 

      Sub CreationSynthese()
Dim mTab()
Dim i As Long
Dim Wk as Workbook
Dim Ws

'.....

     Call RecupFichiers("I:\Volumes de données\", mTab)

     For i = LBound(mTab()) to UBound(mTab())
          Set Wk = Workbooks.Open(mTab(i)
'.......
    Next i

End Sub


      PS: J'ai fait ça de mémoire, il y a peut être des erreurs de syntaxe, mais c'est le principe que j'utilise.
      0
  8. Crysta17 Messages postés 19 Statut Membre
     
    Je vais tenter cette solution.

    Que signifient LBound et Ubound ?
    0
    1. Polux31 Messages postés 7219 Statut Membre 1 204
       
      LBound() est l'indice le plus bas du tableau et UBound() est l'indice le plus haut.
      0
    2. Crysta17 Messages postés 19 Statut Membre
       
      J'ai pu tester ta solution. Malheureusement, toujours la même erreur qui persiste...
      0