Récupération de données multi fichiers

[titi55]

Bonsoir,


J'ai une centaine de fichiers contenant sur leur 2ème onglet, nommé D2, des tableaux strictement identiques quant à leur structure et leur emplacement, seules les données varient.

Les tableaux, situés sur N:\12-Gestion, comportent 10 colonnes et 8 lignes.

Je souhaite mettre ces tableaux à la suite sur un seul fichier sans passer par l'ouverture et copier/coller de mes 100 fichiers.

le fichier destinataire comporte dans son premier onglet les noms des 100 fichiers.

l'objectif est de récupérer les tableaux sur le 2ème onglet

Puis-je automatiser ce traitement en VBA?


Merci de votre aide.

 

[Paritec]

Re : Récupération de données multi fichiers

bonjour titi 55 le forum
oui tu peux automatiser, mais si tu veux le faire sans ouvrir les fichiers il faut que tes fichiers ne soient pas protégés autrement tu ne pourras pas le faire avec connexion ADO
maintenant si tu nous mettais un fichier avec ta liste et l'autre ou il y a ce qui doit être copié on te ferais cela
a+
Papou 🙂

 

[Compte Supprimé 979]

Re : Récupération de données multi fichiers

Salut Titi55,Salut Paritec 😉
Sans fichier pas simple, mais en modifiant ce code, tu devrais y arriver

Option Explicit
Sub AjoutTableau()
  Dim VFic As String, VPath As String
  Dim Dlig As Long  ' Dernière ligne de la liste de fichier
  Dim NextLig As Long ' Dernière ligne pour coller le tableau
  Dim ShtD As Worksheet ' Feuille de destination dans ce classeur
  Dim Lig As Long ' Ligne de la liste de fichiers
  Dim ShtS As Worksheet ' Feuille source du classeur ouvert
  Dim DLigF As Long ' Dernière ligne du fichier ouvert
  ' Définir le répertoire ou se trouvent les fichiers
  VPath = "D:\MonRépertoire\"
  If Right(VPath, 1) <> "\" Then VPath = VPath & "\"
  ' Récupérer la dernière ligne de la liste des fichiers se trouvant dans la colonne A
  Dlig = ThisWorkbook.Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
  ' Définir la feuille de destination pour les tableau
  Set ShtD = ThisWorkbook.Sheets("Feuil2")
  ' Définir la prochaine ligne pour coller le tableau
  NextLig = ShtD.Range("A" & Rows.Count).End(xlUp).Row + 1
  ' Pour chaque ligne
  For Lig = 1 To Dlig
    ' Récupérer le nom du fichier
    VFic = Sheets("Feuil1").Range("A" & Lig).Value
    If Right(VFic, 4) <> ".xls" Then VFic = VFic & ".xls"
    ' Ouvrir le fichier en question
    Workbooks.Open VPath & VFic
    ' Définir la feuille source
    Set ShtS = ActiveWorkbook.Sheets("D2")
    ' Récupérer la dernière ligne du tableau, colonne en fonction
    DLigF = ShtS.Range("A" & Rows.Count).End(xlUp).Row
    ' Copier et coller le tableau
    ShtS.Range("A1:F" & DLigF).Copy Destination:=ShtD.Range("A" & NextLig)
    ' Recalculer la prochaine ligne pour le tableau
    NextLig = ShtD.Range("A" & Rows.Count).End(xlUp).Row + 1
    ' Efface la variable objet pour la feuille source
    Set ShtS = Nothing
  Next Lig
  ' Efface les variables objet
  Set ShtS = Nothing
  Set ShtD = Nothing
End Sub

A+

 

[titi55]

Re : Récupération de données multi fichiers

Très sympa, merci.


j'essaie la macro de BrunoM45 en arrivant au boulot demain matin.

Si je n'y arrive pas, j'ai bien noté la propo de Papou... 😱


Bonne soirée.