Importer des données de 1600 fichiers

Bonjour,

Je dois importer des données de 1600 fichiers excel sur 1 page d'un unique fichier.

Pour le moment j'ai fais le test sur 3 fichiers "fake" pour écrire la macro.

Voilà ma macro :

Nomfic = ThisWorkbook.Name

Dim Ligne As Integer

Dim repertoire As String, fichier As String

repertoire = "c:\user\U531099\Documents\VBA"

ChDir repertoire

fichier = Dir("*.xlsx")

Do While fichier <> ""

If fichier <> Nomfic Then

Workbooks.Open fichier

Range("A1").Select

Selection.End(xlDown).Select

Ligne = ActiveCell.Row

Range("A1:G" & Ligne).Select

Selection.Copy

Workbooks(Nomfic).Sheets("Synthèse").Activate

Range("A1").PasteSpecial

End If

Loop

End sub ()

Cependant quand je la fais tourner, elle tourne en boucle (à cause du Loop) sur le fichier excel n°1

Comment est-ce que je peux faire pour qu'elle copie colle les données des autres fichiers, à la suite du premier ?

bonjour Flohll le forum

tu veux quoi??? copier la plage "A1:G" et dernière ligne dans un seul fichier, mais tu veux les données sur une seule feuille ou sur des feuilles différentes???

1) tu mets ton fichier de récupération dans un dossier X, tu mets 10 fichiers à traiter dans un dossier Y et tu le mets le dossier Y, dans ce même dossier X avec ton fichier récupération.

2) tu compresses le tout en .zip, et tu joins le dossier X zippé au post et je te ferai cela

par contre il faut répondre aux questions ci-dessus

à te relire

a+

Papou

Bonjour flo_Hll, bonjour Papou

Quelle est ta version d'excel ?

C'est Excel 2016

Tu as donc la solution PowerQuery disponible. D'autres pourront mieux te conseiller que moi sur ce point.

Je ne connais pas du tout ...

Cependant quand je la fais tourner, elle tourne en boucle (à cause du Loop) sur le fichier excel n°1

Comment est-ce que je peux faire pour qu'elle copie colle les données des autres fichiers, à la suite du premier ?

Il faudrait a minima fermer le fichier ouvert avant la fin de la boucle (avant loop).

Sinon, comme papou le demande, donne les 3 fichiers test.

Papou,

Sur ces faux fichier je voudrais sélectionner la plage A1:G & Ligne sur le 1 er fichier, et coller dans un excel synthèse

Les 2 autres fichiers je voudrais uniquement A2 : G & Ligne qui se collent à la suite des données déjà collées

Sachant que je ferais ça en vrai sur un dossier de 1600 fichiers qui contiennent à peut près 100 lignes à chaque fois

Le fichier synthèse est nommée synthèse dans le dossier ZIP

Je n'avais pas lu toutes les réponses désolée

3vba.zip (26.45 Ko)

Proposition

Option Explicit
    Dim destinataire As Workbook

Sub compiler()

    Set destinataire = ActiveWorkbook
    Sheets("Synthèse").Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    Range("A2").Select

    MsgBox "Début de la compilation ..."
    ListeFichiers ThisWorkbook.Path
    MsgBox "Fin de la compilation ..."

End Sub
Sub ListeFichiers(Repertoire As String)

    Dim nbRows As Integer
    Dim Fso, SourceFolder, SubFolder, fichier As Object
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)

    ' boucle sur tous les fichiers du répertoire
    For Each fichier In SourceFolder.Files
        If fichier.Name Like "*.xlsx" Then
            If Left(fichier.Name, 2) <> "~$" Then

                Workbooks.Open Filename:=Repertoire & "\" & fichier.Name
                Range("A1").CurrentRegion.Offset(1, 0).Select
                nbRows = Range("A1").CurrentRegion.Rows.Count
                Selection.Copy

                ' change de fichier
                destinataire.Activate
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Application.CutCopyMode = False

                Windows(fichier.Name).Activate
                ActiveWindow.Close

                ' place le curseur sous les données
                destinataire.Activate
                Selection.Offset(nbRows - 1, 0).Select

            End If
        End If
    Next fichier

    ' appel récursif pour les sous-répertoires
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder

End Sub
3xsynthese.xlsm (17.73 Ko)

Bonjour Flohll Steelson le forum

ton dossier en retour, tu ne l'ouvres pas en temporaire.

1) tu le décompresses sur ton bureau

2) tu ouvres le dossier sur ton bureau et tu ouvres xSynthèse.xlsm

3) tu cliques sur le bouton traiter

Si c'est ok, tu n'as plus qu'à mettre tous les fichiers à traiter dans le dossier fichiers à traiter et tu auras ta synthèse

pour 1600 fichiers il faudra quand même à mon avis au minimum 15 minutes avec un PC qui tourne très bien

a+

Papou

3flohll-v1.zip (39.59 Ko)
Rechercher des sujets similaires à "importer donnees 1600 fichiers"