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 sans les ouvrir. tous les fichiers sont dans le même dossier : "C:\donnees".

Le dossier comporte plusieurs dizaine de fichiers xls. Il faut aller chercher les données de l'onglet "synth" dans chaque fichier. 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

Bonjour et bienvenue jodo279,

Oui on peut t'aider, c'est le but du forum non

Par contre, pour faciliter la tâche, peux-tu joindre un bout de fichier source et dire quoi recopier exactement ? Peux-tu également joindre un bout du fichier principal en explicitant où copier les données ?

jodo279 a écrit :

une macro qui me permettent de récupérer les données de fichiers xls sans les ouvrir

Si ça te l'ouvre et te le referme c'est bon ?

Bonjour,

Voici quelques compléments

je veux copier la ligne complete car les données à copier comportent beaucoup de colonnes et plusieurs 100aines de lignes. Les données de chaque fichiers doivent être collées à la suite et sans ligne vide. D'autre part j'ai au moins une bonne 60aintes de fichiers a copier, il faut mieux (a mon avis) lire et copier sans ouvrir et fermer le fichier

Ci-joint un dossier avec les fichiers xls et le résultat que je souhaites.

Merci à vous

1'834exemple.zip (10.72 Ko)
jodo279 a écrit :

D'autre part j'ai au moins une bonne 60aintes de fichiers a copier, il faut mieux (a mon avis) lire et copier sans ouvrir et fermer le fichier

T'inquiètes ! Chaque fichier est ouvert et refermé de suite. Je ne sais pas faire sans ouvrir le fichier.

Voici la macro :

Sub importDonnees()
Dim principal As ThisWorkbook
Dim repertoire As String, fichier As String
    Application.ScreenUpdating = False
    Set principal = ThisWorkbook
    repertoire = "C:\donnees"
    ChDir repertoire
    fichier = Dir("*.xls")
    Do While fichier <> ""
        If fichier <> principal.Name Then
            Workbooks.Open fichier
            On Error GoTo suivant
            With Sheets("synth")
                On Error GoTo 0
                On Error Resume Next
                .[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                .[A:A].Insert Shift:=xlToRight
                .Range("A1:A" & .[b65536].End(xlUp).Row) = Left(fichier, Len(fichier) - 4)
                .UsedRange.EntireRow.Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)
            End With
            ActiveWorkbook.Close False
        End If
suivant:
        If Err.Number = 9 Then MsgBox "Pas de feuille ""synth"" dans le fichier " & fichier, vbExclamation: ActiveWorkbook.Close False
        fichier = Dir
    Loop
End Sub

Les données sont copiées dans la première feuille du classeur de synthèse.

Re bonjour,

La macro ne fonctionne pas complètement, j'obtiens en colonne A sur les 4 1ere lignes "fichier 2" puis en colonne B "fichier 1" et puis rien d'autre. Les données des classeurs ne sont pas copiées.

Merci de votre aide

Voici les fichiers de test :

2'521exemple-v1.zip (12.72 Ko)

Lance la macro importDonnees du fichier résultat voulu. Chez moi ça marche. J'ai modifié la macro pour qu'elle copie les données des fichiers qui se trouvent dans le même répertoire que le fichier principal.

Merci beaucoup la macro fonctionne très bien !

Serait-il possible de la perfectionner : est-il possible de la compléter afin de copier la ligne seulement si elle contient le texte "Y35" ou "G3", etc (par exemple en allant chercher ces valeurs dans les cellules A1:A2 de l'onglet feuil1)

Encore merci

Ok ! Comment ça se fait qu'elle fonctionnait pas avant ?? Une erreur de répertoire ?

jodo279 a écrit :

Serait-il possible de la perfectionner : est-il possible de la compléter afin de copier la ligne seulement si elle contient le texte "Y35" ou "G3", etc (par exemple en allant chercher ces valeurs dans les cellules A1:A2 de l'onglet feuil1)

Tu donnes en exemple les cellules A1:A2, mais le texte "Y35" ou "G3" peut être sur toute la colonne A n'est-ce pas ? Et pourquoi tu parles de l'onglet feuil1 ? C'est plus l'onglet "synth" ?

Euh en faite oui , le répertoire était pas le bon (erreur de frappe) ...

Voila dans l'onglet "feuil1" cellule A1:A2(du fichier "resultat voulu") j'indique les valeurs que je recherche "Y35" ou "G3" . Dans le dossier "C:\donnees" et parmi les fichiers xls de ce dossier pour l'onglet "synth" je recherche et je copie la ou les lignes qui contiennent "Y35" ou "G3" (sur toutes les colonnes A des fichiers). Si la ligne ne contient pas "Y35" ou "G3" elle ne doit pas être copié. (mais si elle contient "TotoY35" elle doit être copiée)

Toutes les données contenues dans les fichiers ne m'intéressent pas, c'est pour sélectionner celle que je veux analyser par la suite

Pour que ce soit plus claire je joint le fichier :

Merci de votre aide

653exemple-v2.zip (14.82 Ko)

Voici :

1'983exemple-v3.zip (17.41 Ko)

Pour les critères, il faut que tu mettes le nom du champ contenant les critères. J'ai mis une petite explication dans l'onglet "Feuil1".

Le répertoire est à adapter. Si problème, reviens.

OK Merci beaucoup !

ça a l'air de très bien marcher.

Je te remercie

A+

Jodo

Si ton problème est résolu :

resolu

Bonjour à tous,

La macro fonctionne très, serait-il possible de l'adapter pour une problématique proche.

Il faudrait que la macro allie chercher les données (même principe) dans un onglet dont le nom n'est jamais le même.

Par contre l'onglet contient toujours "arc" : exemple "12arc_18" ou "arc526".

Merci d'avance

il faudrait adapter le code suivant (en gras : au lieu d'un nom d'onglet "synth" il faudrait rechercher un nom d'onglet contenant arc ("12arc_18") :

Sub importDonnees()

Dim principal As ThisWorkbook

Dim repertoire As String, fichier As String

Application.ScreenUpdating = False

Set principal = ThisWorkbook

repertoire = "C:\donnees"

ChDir repertoire

fichier = Dir("*.xls")

Do While fichier <> ""

If fichier <> principal.Name Then

Workbooks.Open fichier

On Error GoTo suivant

With Sheets("synth")

On Error GoTo 0

On Error Resume Next

.[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete

.[A:A].Insert Shift:=xlToRight

.Range("A1:A" & .[b65536].End(xlUp).Row) = Left(fichier, Len(fichier) - 4)

.UsedRange.EntireRow.Copy Destination:=principal.Sheets(1).[a65536].End(xlUp).Offset(1)

End With

ActiveWorkbook.Close False

End If

suivant:

If Err.Number = 9 Then MsgBox "Pas de feuille ""synth"" dans le fichier " & fichier, vbExclamation: ActiveWorkbook.Close False

fichier = Dir

Loop

End Sub

Voici la macro modifiée :

Sub importDonnees()
Dim principal As ThisWorkbook, tablo, nlign As Byte, i As Byte, derlign As Long
Dim repertoire As String, fichier As String
    Application.ScreenUpdating = False
    With Sheets("Feuil1")
        ReDim tablo(1 To .[a65536].End(xlUp).Row)
        tablo = .Range("A1:A" & .[a65536].End(xlUp).Row)
        nlign = UBound(tablo)
        If nlign > 1 Then
            For i = 2 To nlign
                tablo(i, 1) = "*" & tablo(i, 1) & "*"
            Next i
        End If
    End With
    Set principal = ThisWorkbook
    repertoire = ThisWorkbook.Path    'répertoire à adapter
    ChDir repertoire
    fichier = Dir("*.xls")
    Do While fichier <> ""
        If fichier <> principal.Name Then
            Application.DisplayAlerts = False
            Workbooks.Open fichier
            For i = 1 To Sheets.Count
            If Sheets(i).Name Like "*arc*" Then Exit For
            Next i
            On Error GoTo suivant
            With Sheets(i)
                On Error GoTo 0
                On Error Resume Next
                .[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                .[A:A].Insert Shift:=xlToRight
                derlign = .[b65536].End(xlUp).Row
                .Range("A1:A" & derlign) = Left(fichier, Len(fichier) - 4)
                .Range("A" & derlign + 1 & ":A" & derlign + nlign) = tablo
                With .UsedRange
                    .Resize(.Rows.Count - nlign).AdvancedFilter Action:=xlFilterInPlace, _
                                                                CriteriaRange:=.Range("A" & derlign + 1 & ":A" & derlign + nlign), _
                                                                Unique:=False
                    .Range("_FilterDataBase").Offset(1).Resize(.Range("_FilterDataBase").Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                            principal.Sheets(1).[a65536].End(xlUp).Offset(1)
                End With
            End With
            ActiveWorkbook.Close False
        End If
suivant:
        If Err.Number = 9 And fichier <> principal.Name Then MsgBox "Pas de feuille contenant ""arc"" dans le fichier " & fichier, vbExclamation: ActiveWorkbook.Close False
        fichier = Dir
    Loop
    With principal.Sheets(1)
        If .Application.CountA(.Rows(1)) = 0 Then .Rows(1).Delete
        .Select
    End With
End Sub

Bonjour vba-new,

Merci pour ton aide, je teste la macro et je te confirme que tout va bien.

A+

Jodo279

-- 20 Fév 2010, 18:33 --

Bonjour,

J'ai un problème avec la macro, quand je la lance j'ai ce message qui s'affiche ""Pas de feuille contenant ""arc"" dans le fichier " pourtant l'onglet contient bien "arc". J'ai essayé de faire des modif mais sans succès ..

Merci d'avance

Jodo279

-- 20 Fév 2010, 19:07 --

Bonjour, j'ai pas compris mon dernier message n'est pas sorti sur le forum

le voici : J'ai un problème avec la macro, quand je la lance j'ai ce message qui s'affiche ""Pas de feuille contenant ""arc"" dans le fichier " pourtant l'onglet contient bien "arc". J'ai essayé de faire des modif mais sans succès ..

Merci d'avance

Jodo279

40stats-2019.xlsx (27.74 Ko)

Peux-tu joindre le fichier contenant la feuille contenant "arc" ?

Re bonjour,

Voici les fichiers la macro et un exemple de fichier à scruter.

Jodo279

148import-arc.zip (17.73 Ko)

Re,

Oui c'est normal, tu dois mettre le code que je t'ai donné dans un module et non dans le code du thisworkbook.

Voici ton fichier en retour avec quelques modifs du code :

348import-arc.zip (9.45 Ko)

Le code rapatriant les données dans la première feuille du fichier "import arc.xls", une feuille est créée automatiquement pour recueillir les données.

N'oublie pas qu'il faut te placer sur la feuille contenant le champ de critères avant de lancer la macro.

Bonsoir VBA new

Je te remercie tout marche très bien. Grâce à toi je vais gagner pas mal de temps.

Encore merci !

A+

Jodo279

Bonjour,

Je suis également à la recherche d'une matrice pour extraire les données depuis plusieurs fichiers xls.

Je souhaiterais obtenir une macro qui permettent d'extraire les données des feuil1 à chaque fois mais en spécifiant la colonne et la plage de ligne à prendre en compte (exemple : extraire les toutes les données présentes dans la colonne G, de la ligne 6 à 17 uniquement)

Merci par avance de votre aide.

Rechercher des sujets similaires à "extraction donnees fichiers xls"