Rassembler plusieurs fichiers excel en un

Version imprimable

06/06/2008, 14h46
mariafan

Rassembler plusieurs fichiers excel en un

Salut à tous,
Je suis débutante dans VBA et je dois réaliser un code qui permet de rassembler plusieurs fichiers excel en un seul.
Est ce que quelqu'un parmi vous a une idée?
Merci d'avance.
06/06/2008, 14h54
ouskel'n'or

Regarde ici http://www.developpez.net/forums/sho...d.php?t=442352, je pense que ça répond à ta question ;)
Sinon, tu dis

Le code qui convient le plus à mon cas est le suivant:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
'
' Assemble à la suite plusieurs fichiers dans un classeur.
'
Sub Assemble()
Dim CL1 As Workbook, CL2 As Workbook
Dim FL1 As Worksheet, FL2 As Worksheet
Dim Fich As Variant, i As Byte, Rep$
 
    'Répertoire des fichiers à copier
    Rep = "C:\Documents and Settings\JQH\Bureau\Mari\boulot_test\test\"
    Set CL1 = ThisWorkbook
 
    'Ajoute une feuille au classeur destiné à recevoir les données des autres classeurs
    CL1.Sheets.Add
    CL1.ActiveSheet.Name = "FeuilCumul"
 
    Set FL1 = CL1.ActiveSheet 'Instance le la feuille
 
    'Crée le tableau des fichiers du répertoire
    Set Fich = application.FileSearch
 
    'Ouverture des fichiers du répertoire
    With Fich
        .LookIn = Rep
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
            For i = 1 To .FoundFiles.Count
                Set CL2 = Workbooks.Open(.FoundFiles(i))
                DoEvents
 
                'Parcours des feuilles de chaque classeur
                For Each FL2 In CL2.Worksheets
                    'Dernière ligne où coller les données copiées dans FL2
                    NoLigne = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1
 
                    'Copie de la plage renseignée de chaque feuille du classeur
                    FL2.Range(FL2.Cells(1, 1), _
                        FL2.Cells(FL2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row, _
                        FL2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row)).Copy _
                        FL1.Range("A" & NoLigne)
                    DoEvents
                    Set FL2 = Nothing
                Next
                CL2.Close False 'fermeture du classeur copié
                DoEvents
                Set CL2 = Nothing
            Next i
        Else
            MsgBox "Aucun fichier dans le répertoire " & Rep
        End If
    End With
End Sub

Problème, qu'on j'exécute le module, il ne m'affiche aucune donnée. :cry:

06/06/2008, 17h41
ouskel'n'or
Effectivement ! :oops:
Remplace ces lignes qui n'ont aucun sens

Citation:

FL2.Range(FL2.Cells(1, 1), _
FL2.Cells(FL2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row, _
FL2.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row)).Copy _
FL1.Range("A" & NoLigne)

par celles-ci qui ont fait leurs preuves
Code:

1 2 FL2.Range("A1:" & Split(FL2.UsedRange.Address(0, 0), ":")(1)).Copy _ FL1.Range("A" & NoLigne)
Comprends pas comment j'ai pu mettre ça :cry:
Tu dis
06/06/2008, 17h48
mariafan
Merci pour ton aide.
Est ce que tu peux m'expliquer STP ce bout de code que t'as mis (car je suis débutante :oops:) :
Code:

1 2 FL2.Range("A1:" & Split(FL2.UsedRange.Address(0, 0), ":")(1)).Copy _ FL1.Range("A" & NoLigne)
Mais juste un petit bémol, il me met des vides entre les contenus de chaque fichier.

Merci encore.
06/06/2008, 18h30
ouskel'n'or
Citation:
Envoyé par mariafan

Merci pour ton aide.
Est ce que tu peux m'expliquer STP ce bout de code que t'as mis (car je suis débutante :oops:) :

Code:

1 2 FL2.Range("A1:" & Split(FL2.UsedRange.Address(0, 0), ":")(1)).Copy _ FL1.Range("A" & NoLigne)
Oui, je peux (!)
FL2.UsedRange.Address donne la plage de données de ta feuille en adresse absolue. Ex : "$A$1:$R$554"
FL2.UsedRange.Address(0, 0) donne la plage mais sans les $
Comme ça je peux faire un "Split" de la plage en utilisant les ":" comme séparateur
Plage = "A1:R554"
Tablo = Split("A1:R554", ":") transforme plage en tableau
où
Tablo(0) = "A1"
et
Tablo(1) = "R554"
et donc l'adresse de la fin des données.
Si j'étais certain que A1 soit renseigné, j'aurais pu simplifier... Comme je n'en sais rien, cette syntaxe me permet, si tu as des lignes ou des colonnes entièrement vides dans la plage de données, de prendre malgré tout la plage complète.

Citation:

Envoyé par mariafan

Mais juste un petit bémol, il me met des vides entre les contenus de chaque fichier.

Es-tu certaine que les lignes sont complètement vides ? Ces trous ne sont-ils pas dans tes fichiers ? N'y a-t-il pas des lignes renseignées en dessous ?
A+

Merci pour tes explications.
C'est j'ai résolu le pbm des vides. voici le code:
Code:

1 2 3 Range(Cells(Cells.Find("*", , , , xlByColumns, xlPrevious).Column + 1), Cells(1, 254)).EntireColumn.Delete Range(Cells(Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1, 1), Cells(65536, 1)).EntireRow.Delete ActiveSheet.UsedRange.Select
Par contre tu sais comment, je pourrai avoir l'entête du 1er fichier copié et ne pas l'avoir pour les autres fichiers. cad, la première fois, il me copie tout le fichier et pour les autres, il me copie juste les données sans l'entête.

Merci d'avance.

Tu peux faire ça n'importe où, avant ou après copie de tes classeurs,
seulement après ouverture du premier classeur, tu récupères le nom
Code:

1 2 3 4 For i = 1 To .FoundFiles.Count Set CL2 = Workbooks.Open(.FoundFiles(i)) DoEvents if i = 1 then nomFich = CL2.name
déclare nomfich as string ;)

09/06/2008, 10h36
mariafan

Salut,
j'ai essayé le bout de code mais ça ne marche pas.
Je crois que je me suis mal exprimée.
Alors, le souci est le suivant:
les fichiers que je veux rassembler sont pareils dans leur structure (que les données qui changent d'un fichier à un autre).
Je voudrais donc avoir les 4 premières lignes juste pour le premier fichier et qu'il me commence la copie pour les autres fichiers à partir de la 5 éme ligne.

Est ce quelqu'un sait comment faire?

Merci d'avance.

En bref, tu cherches la première ligne vide de ta feuille avant chaque copie.
Je t'ai proposé un code, tu en as proposé un autre... Que veux-tu de plus ?
Tu fais une exception pour le premier en ne copiant que les 4 premières lignes, et pour les autres, tu copies à partir de la ligne 5 jusqu'à la dernière ligne renseignée.
Tu ajoutes simplement Compteur as byte

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub Copie(FL1 As Worksheet, Fichier, Compteur as byte)
Dim CL2 As Workbook
Dim FL2 As Worksheet
Dim i As Byte, Rep$, NoLigne As Long
 
     Set CL2 = Workbooks.Open(Fichier)
 
        'Parcours des feuilles de chaque classeur
        For Each FL2 In CL2.Worksheets
            'Dernière ligne où coller les données copiées dans FL2
            NoLigne = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1
            if Compteur = 1 then
            'Copie les 4 premières lignes du classeur 1
                FL2.Range("A1:" & FL2.Cells(4, Range("IV1").End(xlToLeft).Column).Address).Copy _
                FL1.Range("A1")
              else
                'Copie de la plage renseignée de chaque feuille du classeur
                FL2.Range("A5:" & Split(FL2.UsedRange.Address(0, 0), ":")(1)).Copy _
                FL1.Range("A" & NoLigne)
            endif
            DoEvents
            Set FL2 = Nothing
        Next
        CL2.Close False 'fermeture du classeur copié
        DoEvents
        Set CL2 = Nothing
End Sub

Pour l'appel de cette macro, tu l'as ici http://www.developpez.net/forums/sho...d.php?t=442352
et tu ajoutes simplement i dans l'appel

Code:

1
2
3
4
            For i = 1 To .FoundFiles.Count
                DoEvents
                 Copie FL1, .FoundFiles(i), i
            Next

Plus simple pour copier les 4 premières lignes du 1er fichier

Code:

1
2
3
4
5
            if Compteur = 1 then
                FL2.range("A1:A4").entirerow.copy _
                FL1.Range("A1")
              else
                '...

09/06/2008, 11h32
mariafan

Merci déjà, et je suis désolée si des fois je ne comprends pas :oops: , c'est juste parce que c'est ma première appli en VB.

Non,
Ce que je veux faire c'est:
Pour le premier fichier, je copie tout
Pour les autres fichiers, je copie à partir de la 5 éme ligne.

Quand, j'intégre ton code au mien, comme suit:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
'Parcours des feuilles de chaque classeur
                For Each FL2 In CL2.Worksheets
 
                    'Dernière ligne où coller les données copiées dans FL2
                    NoLigne = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row
 
                    'Copie de la plage renseignée de chaque feuille du classeur
                    'FL2.UsedRange.Address donne la plage de données de la feuille en adresse absolue. Ex : "$A$1:$R$554"
                    'FL2.UsedRange.Address(0, 0) donne la plage mais sans les $
                    'Comme ça je peux faire un "Split" de la plage en utilisant les ":" comme séparateur
                    'Plage = "A1:R554"
 
                    If Compteur = 1 Then
            'Copie les 4 premières lignes du classeur 1
                FL2.Range("A1:" & FL2.Cells(4, Range("IV1").End(xlToLeft).Column).Address).Copy _
                FL1.Range("A1")
              Else
                'Copie de la plage renseignée de chaque feuille du classeur
                FL2.Range("A5:" & Split(FL2.UsedRange.Address(0, 0), ":")(1)).Copy _
                FL1.Range("A" & NoLigne)
            End If
 
                    DoEvents
                    Set FL2 = Nothing
                Next
                CL2.Close False 'fermeture du classeur copié
                DoEvents
                Set CL2 = Nothing

Il me supprime les 4 premières lignes de tous mes fichiers excel même pour le premier alors que moi je veux qu'il me copie tout le premier fichier et pour les autres fichiers qu'il commence à copier à partir de la 5éme ligne.
Merci d'avance.