Macro : Rassembler plusieurs fichiers Excel 2007 dans un autre fichier

roidurif

XLDnaute Occasionnel
Bonjour,

Je souhaite rassembler plusieurs centaines de fichiers Excel 2007 dans un autre seul fichier (Données.xlsx).

Ces 100 fichiers sont des tableaux (90 colonnes et x lignes selon fiches) et sont nommées de cette façon : ex Fiche1.xls, Fiche2.xls, Fiche3.xls,….. Fiche100.xls.

Le but de la macro est de rapatrier dans le document (Données.xls), chaque tableaux, les uns à la suite des autres dans une seule même feuille (Feuil1).

Merci de votre aide.
 
Dernière édition:

roidurif

XLDnaute Occasionnel
Re : Macro : Rassembler plusieurs fichiers Excel 2007 dans un autre fichier

Bonjour

J'ai trouver ce code sur internet, qui fonctionne sur 2007. Mais le probleme est qu' une fois qu'il copie jusqu'à 70 000 lignes, il revient à la 1ere lignes, et donc il écrase les données du début.

Le but est de copier les données les unes apres les autres.

Merci de votre aide.

Code:
Public msg As String
 
Sub Appel() 
Dim Chemin As String
    Application.ScreenUpdating = False
        Chemin = "D:\xls\Test\"
        Ouvrir Chemin
    Application.ScreenUpdating = True
    If msg <> "" Then _
    MsgBox "Pour des raisons de protection ou autres, n'ont pu être copiées " & vbCrLf & msg
End Sub

Sub Ouvrir(Chemin As String)
Dim NomFich As String
Dim CL2 As Workbook 'fichier copié
    Application.DisplayAlerts = False 'Evite les messages d'Excel
    'Evite l'exécution éventuelle de macros liées aux fichiers ouverts
    Application.EnableEvents = False
        NomFich = Dir(Chemin & "*.xls")
        If NomFich = "" Then
             MsgBox "Aucun fichier trouvé dans " & Chemin
             Exit Sub
        End If
        Do While NomFich <> ""
            Set CL2 = Workbooks.Open(Chemin & NomFich)
            DoEvents
            Copie CL2
            CL2.Close False
            DoEvents
            ThisWorkbook.Save 'enregistrement du classeur après chaque copie
            DoEvents
            NomFich = Dir
        Loop
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub


Sub Copie(CL2 As Workbook)
Dim LaFeuille As Worksheet, FL1 As Worksheet, derlig As Long
    Set FL1 = ThisWorkbook.Worksheets("feuil1") 'feuille où les données sont collées
    For Each LaFeuille In CL2.Worksheets 'parcours du classeur à copier
        'On vérifie que la feuille n'est pas vide
        If Not (LaFeuille.UsedRange.Address = "$A$1" And Range("A1") = "") Then
            derlig = FL1.Range("A" & Rows.Count).End(xlUp).Row + 1 'première ligne vide
            On Error Resume Next
            LaFeuille.UsedRange.Copy FL1.Cells(derlig, 1)
            DoEvents
            If Err <> 0 Then
                msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
                On Error GoTo 0
            End If
        End If
    Next
End Sub
 
G

Guest

Guest
Re : Macro : Rassembler plusieurs fichiers Excel 2007 dans un autre fichier

Bonjour,

Ta question concerne Excel 2007 et aurait plus sa place dans le sous-forum dédié.

Ceci étant dit Enregistre ton fichier 'Donnees.xls' en format 2007 'Donnees.xlsx' qui lui pourra contenir jusqu'à 1048576 lignes.

A+
 

roidurif

XLDnaute Occasionnel
Re : Macro : Rassembler plusieurs fichiers Excel 2007 dans un autre fichier

Bonjour HASCO,


Effectivement j'ai homis de dire que j'ai Enregistré mon fichier 'Donnees.xls' en format 2007 'Donnees.xlsx', mais malgré cela il copie jusqu' à 70 000 lignes et reviens au début pour ecraser les donnés.


Merci de l'aide
 

Discussions similaires

Statistiques des forums

Discussions
311 723
Messages
2 081 934
Membres
101 844
dernier inscrit
pktla