Extraire des données de plusieurs fichiers excels

[Moonshine33]

Bonjour à tous !

Après 2j de recherches d'une solution en tentant d'adapter des codages du forum, je lance un nouveau fil de conversation...Mon niveau en VBA a du bien baisser depuis la dernière fois où j'en ai eu besoin

Je cherche à extraire des données de plusieurs classeurs excel regroupés dans un même dossier. Ces données sont situées sur une même plage de cellules et sur une même feuille de chaque classeur (qui comporte d'autres feuilles).
Je souhaite regrouper les données dans un même classeur récapitulatif et que ces données se mettent les unes à la suite des autres au fil de l'ouverture des classeurs pour extraction de données. Il faut également que lorsque j'exécute ma macro il y ait une suppression des anciennes données pour mettre les nouvelles.

En espérant avoir été claire sur mon besoin, je peux vous bidouiller un fichier test si vous voulez mais je ne vais pas pouvoir vous mettre un dossier avec des fichiers excel.
Merci beaucoup par avance pour votre aide !

Moonshine.

 

[camarchepas]

Re : Extraire des données de plusieurs fichiers excels

Bonjour ,

Bienvenue à bord d'XLD,

un code à adapter mais qui devrait pas être loin de ce que tu cherches

L'onglet synthese doit exister dans le classeur contenant la macro

Sub FusionFichiers()
 
 Dim Classeur As String
  Dim Chemin As String
  Dim Onglet As Worksheet
  Dim LigneFin As Long, LigneFinACopier As Long, LigneFinCopie as long 
  'Exemple : Chemin à adapter
  Chemin = "C:\Test_Fusion_Classeurs\"
  'Si uniquement des fichiers xls ou xslx , modifier l'extension en conséquence
  Classeur = Dir(Chemin & "*.xls") 
 If Classeur = "" Then MsgBox " Le répertoire " & Chemin & " est vide ou inexistant": Exit Sub
  Do
  If Classeur <> "" Then
  Application.EnableEvents = False
  Workbooks.Open Chemin & Classeur
  For Each Onglet In Workbooks(Classeur).Worksheets
  'Ne traite que les onglets dont le nom est Feuil1 : A adapter 
       If Onglet.Name = "Feuil1" Then 
         LigneFinACopier = Onglet.Range("A" & Rows.Count).End(xlUp).Row
         LigneFinCopie = ThisWorkbook.Sheets("Synthese").Range("A" & Rows.Count).End(xlUp).Row+1
         Onglet.Range("A1:H" & LigneFinACopier).Copy Destination:=ThisWorkbook.Sheets("Synthese").Range("A" & lignefincopie)
        exit for
       End If
  Next
  Workbooks(Classeur).Close False
  Application.EnableEvents = True
  End If
  Classeur = Dir
  Loop Until Classeur = ""
  End Sub

 

[Moonshine33]

Re : Extraire des données de plusieurs fichiers excels

Merci pour ta réponse Nono !!! J'ai eu du mal à revenir usr le message car j'ai difficilement amadoué le tableau de bord.

J'ai juste un petit souci au lancement de la macro, excel me dit : "Erreur d'exécution '9' : l'indice n'appartient pas à la sélection", et le débogage donne :

Sub FusionFichiers()
 
 Dim Classeur As String
  Dim Chemin As String
  Dim Onglet As Worksheet
  Dim LigneFin As Long, LigneFinACopier As Long, LigneFinCopie as long 
  'Exemple : Chemin à adapter
  Chemin = "C:\Test_Fusion_Classeurs\"
  'Si uniquement des fichiers xls ou xslx , modifier l'extension en conséquence
  Classeur = Dir(Chemin & "*.xls") 
 If Classeur = "" Then MsgBox " Le répertoire " & Chemin & " est vide ou inexistant": Exit Sub
  Do
  If Classeur <> "" Then
  Application.EnableEvents = False
  Workbooks.Open Chemin & Classeur
  For Each Onglet In Workbooks(Classeur).Worksheets
  'Ne traite que les onglets dont le nom est Feuil1 : A adapter 
       If Onglet.Name = "Feuil1" Then 
         LigneFinACopier = Onglet.Range("A" & Rows.Count).End(xlUp).Row
         LigneFinCopie = ThisWorkbook.Sheets("Synthese").Range("A" & Rows.Count).End(xlUp).Row+1
        [COLOR="#FF0000"] Onglet.Range("A1:H" & LigneFinACopier).Copy Destination:=ThisWorkbook.Sheets("Synthese").Range("A" & lignefincopie)[/COLOR]        
exit for
       End If
  Next
  Workbooks(Classeur).Close False
  Application.EnableEvents = True
  End If
  Classeur = Dir
  Loop Until Classeur = ""
  End Sub

Je crois qu'on y était presque là, ton codage me paraissait à vue d'oeil être ce que j'attendais. Tu as une idée d'où peut venir l'erreur ? J'ai reverrifié le nom de mon onglet source, c'est pourtant ça... (après j'ai des espaces dans ce nom d'onglet, peut être pas terrible)

Moonshine

 

[Moonshine33]

Re : Extraire des données de plusieurs fichiers excels

J'ai trouvé l'erreur (de ma part d'ailleurs) ! La macro fonctionne bien, c'est top, il y a juste un petit point que je voudrais modifier, je voudrais que la plage de copie sur mes feuilles sources commence à la L8 (en , j'ai tenté pleusieurs trucs mais ça n'a pas marché pour l'instant et je suppose que tu dois avoir exactement où je peux entrer ce paramètre

Merci bc, déjà rien que comme ça c'est top, ça va vraiment me changer la vie.

Moonshine

 

[camarchepas]

Re : Extraire des données de plusieurs fichiers excels

Bonjour,

Super donc ,

Voici la ligne à modifier :

Onglet.Range("A1:H" & LigneFinACopier).Copy Destination:=ThisWorkbook.Sheets("Synthese").Range("A" & lignefincopie)

par

Onglet.Range("A8:H" & LigneFinACopier).Copy Destination:=ThisWorkbook.Sheets("Synthese").Range("A" & lignefincopie)

 

[Moonshine33]

Re : Extraire des données de plusieurs fichiers excels

Merci pour ta réponse. Malheureusement, j'avais supposé que c'était ça et en modifiant ça n'a pas marché...Il n'y a qu'un seul endroit où on modifie le 1 pour un 8, c'est bien ça ?

Moonshine

 

[camarchepas]

Re : Extraire des données de plusieurs fichiers excels

a oui et en plus

donc , un problème avec le fichier source surement

 

[Moonshine33]

Re : Extraire des données de plusieurs fichiers excels

C'est bon !! en fait il me manquait juste un petit clearcontent, je n'avais pas fait attention qu'il n'y en avait pas et à chaque exécution de macro tout mon contenu se copiait à la suite donc je ne voyais pas les modifs de la nouvelle macro . Merci beaucoup pour ton aide, tout fonctionne à merveilles maintenant !

Bonne fin de journée.

Moonshine