Extraction de données depuis plusieurs fichiers xls

Bonjour à tous,

Je suis nouveau et je voudrais faire une macro qui me permettent de récupérer les données de fichiers xls contenus dans des sous dossiers du dossier "donnees" sans les ouvrir. Tous les fichiers sont dans le même dossier : "C:\donnees".

Ce dossier comporte plusieurs dizaine de fichiers xls. Il faut aller chercher les données contenues dans certaines cases ( par exemple A1 et B8 ) du premier onglet dans chaque fichier et les mettre pour chaque fichier sur la même ligne dans un fichier commun.

J'ai aussi besoin d'avoir le nom du fichier source dans la 1ere colonne et en face de chaque ligne recopiée.

Pouvez vous m'aider ? je ne m'en sort pas.

Merci d'avance

Hello,

Une proposition :

Adapter les cellules a récupérer + chemin + extension

copie les cellule de la feuille 1 vers la feuille 1

Sub return_data()

Const strpath_data As String = "C:\Users\Dahmien\Documents\EXCEL_VBA\test_txt\"
Const strextend As String = ".xlsx"

Dim strFile$, str_namefile$
Dim vartab_rng, varvalues
Dim lngi&, lngj&
Dim wkbsynt As Workbook, wkbdata As Workbook
Dim wkssynt As Worksheet, wksdata As Worksheet

Set wkbsynt = ThisWorkbook
Set wkssynt = wkbsynt.Sheets(1)

strFile = Dir(strpath_data & "*" & strextend)

vartab_rng = Array("A1", "B1") 'ICI ADAPTER LES CELLULES A RECUPERER DANS CHAQUE CLASSEURS

Application.Calculation = xlManual
Application.ScreenUpdating = False
lngi = 1
Do While Len(strFile) > 0
    lngj = 2
    wkssynt.Cells(lngi, 1) = strFile
    Set wkbdata = Workbooks.Open(strpath_data & strFile)
    Set wksdata = wkbdata.Sheets(1)
    With wksdata
            For Each varvalues In vartab_rng
                wkssynt.Cells(lngi, lngj) = .Range(CStr(varvalues)).Value
                lngj = lngj + 1
            Next varvalues
    End With
    wkbdata.Close False
    Set wksdata = Nothing
    Set wkbdata = Nothing
    lngi = lngi + 1
    strFile = Dir()
Loop
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Set wkbsynt = Nothing
Set wkssynt = Nothing

MsgBox "Fin du traitement"

End Sub

Bonjour,

Merci énormément, c'est exactement ce que je voulais. Serait-il possible d'ajouter une fonction ou si des informations étaient déjà présente de mettre les lignes à la suite.

Bonne journée

Pour continuer à la suite de ce qui est déjà écrit :

lngi = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row + 1

Si j'ai bien compris, tu veux que lorsque tu lances la macro, au lieu que le résultat s'indique à la dernière ligne + 1 et non en ligne 1 ?

Si oui, tu peux modifier cette ligne :

lngi = 1

par

lngi = wkssynt.Cells(Rows.Count, 1).End(xlUp).Row