Discussion :

[ouistit64]

Je souhaite récupérer un tableau sur plusieurs feuilles excel et réunir tout ces tableaux les uns à la suite des autres. Les tableaux ont le même nombre de colonnes et commencent à la ligne 2 mais le nombre de lignes est variable. Auriez-vous une idée pour que la macro me récupère le tableau qu'à partir de la ligne 5 et qu'elle mette les tableaux les uns après les autres sans laisser de lignes vides entre chaque récupération de tableaux. Ma macro fonctionne à peu près bien puisqu'elle récupère les tableaux (colonne A à AB) mais je n'arrive pas à récupérer les tableaux à partir de la ligne 5 et les faire suivre puisqu'il y a de nombreuses lignes qui s'intercalent entre les tableaux. Quelqu'un m'a conseillé ceci mais je n'y arrive pas ( la fonctionnalité "SpecialCells(xlCellTypeLastCell)" (edition-atteindre-cellulevides) ne fonctionne pas correctement dès que l'on efface le contenu decertaines cellules.pour vous positionner dans la feuille "cumul" à la bonne ligne, je vous suggèreplutot de faire une boucle vérifiant, pour chaque ligne, le contenu, par ex, dela première colonne jusqu'à ce que ce contenu soit vide (="") avec un do untilpar exemple.Lorsque la cellule vide est atteinte, vous faites un copier-coller. Pour spécifier le tableau à copier, je vous suggère d'utiliser la propriété"currentregion" qui permettra de prendre tout le tableau, sans avoir à sepréoccuper de sa dimension.Enfin, je ne comprends pas vraiment l'utilité du "set fl2=nothing", ni celle desinstructions "do events"). Voici ma macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
54
55
Sub Test3()
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 = "t:\Outillages\"
    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
                     a$ = FL2.Range("A1").SpecialCells(xlCellTypeLastCell).Address
    b$ = "A" & FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1
    NoLigne = FL1.Range(a$).Row
    NoColonne = FL1.Range(a$).Column
    FL2.Range(Cells(1, 1).Address, Cells(NoLigne, NoColonne).Address).Copy _
    Destination:=FL1.Range(b$)
                    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

Merci de votre aide

[ancel17]

Remplace

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
                    'Copie de la plage renseignée de chaque feuille du classeur
                     a$ = FL2.Range("A1").SpecialCells(xlCellTypeLastCell).Address
    b$ = "A" & FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1
    NoLigne = FL1.Range(a$).Row
    NoColonne = FL1.Range(a$).Column
    FL2.Range(Cells(1, 1).Address, Cells(NoLigne, NoColonne).Address).Copy _
    Destination:=FL1.Range(b$)

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
                    'Copie de la plage renseignée de chaque feuille du classeur
                     FL2.Range("A5:AB" & FL2.Range("A1").SpecialCells(xlCellTypeLastCell).Row).Copy FL1.Range("A" & FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1)

[ouistit64]

salut
j'ai essayé et ça me mets erreur définie par l'application ou l'objet. Merci de t'interresser à mon cas

[mayekeul]

bonjour,

tu peux essayer comme cela si tu veux?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Test3()
Dim CL1 As Workbook, CL2 As Workbook
Dim FL1 As Worksheet, FL2 As Worksheet
Dim Fich As Variant, i As Byte, Rep$
Dim R As Integer, C As Integer
    'Répertoire des fichiers à copier
    Rep = "t:\Outillages\"
    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
                    'On admet dans la procédure que la première colonne de chaque tableau ne contiens pas de cellule vide
                    'Copie de la plage renseignée de chaque feuille du classeur
                    'On définit le numero de colonne
                    C = FL2.Cells(5, 1).End(xlToRight).Column
                    'On récupere le numéro de la dernière ligne
                    R = FL2.Cells(5, 1).End(xlDown).Row
                    'On défini le tableau et on copie
                    FL2.Range(Cells(5, 1), Cells(R, C)).Copy
                    FL1.Cells(1, 1).End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
                    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