[XL-2010] VBA - Importer le contenu de différents fichiers Excel vers un unique fiichier

VBA - Importer le contenu de différents fichiers Excel vers un unique fiichier

Bonjour à tous,

Je cherche à importer vers un unique fichier les valeurs contenues dans plusieurs fichiers Excel.

J'aimerais pouvoir importer les données les unes a la suite des autres. C'est a dire que par exemple , les données issues du premier fichier sont copiées de A5 a A45 , et que le second soit copié de A46 à A120.

Je n'ai trouvé que des codes assez complexes et suis totalement perdu.

Merci

Bonjour,

Testes le code ci-dessous en ayant au préalable défini le chemin du dossier. Les feuilles cibles sont les premières de chaque classeur (Worksheets(1) feuille la plus à gauche dans les onglets) :

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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
 
Sub Test()
 
    Dim Cls As Workbook
    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Tbl() As String
    Dim I As Integer
    Dim Chemin As String
    Dim DerLigne As Long
 
    'adapter le chemin du dossier où se trouvent les classeurs cibles...
    Chemin = "E:\Dossier\"
 
    'appel de la fonction pour récupérer les noms des classeurs
    Tbl = EnumFichiers(Chemin, ".xls*") 'astérisque si tous les fichiers Excel (.xls, .xlsx, .xlsm, etc...)
 
    'si initialisé (au moins 1 classeur)
    If Not (Not Tbl) Then
 
        'boucle sur le tableau
        For I = 1 To UBound(Tbl)
 
            'ouvre le classeur
            Set Cls = Workbooks.Open(Chemin & Tbl(I))
 
            'défini la plage en colonne A à partir de A1 sur la première feuille du classeur
            With Cls.Worksheets(1): Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
 
            With ThisWorkbook.Worksheets(1) 'sur la 1ère feuille du classeur
 
                DerLigne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1  'sur colonne A
                If DerLigne = 2 And .Range("A1").Value = "" Then DerLigne = 1
                .Range(.Cells(DerLigne, 1), .Cells(DerLigne + Plage.Rows.Count - 1, 1)).Value = Plage.Value
 
            End With
 
            'referme
            Cls.Close False
 
        Next I
 
    End If
 
End Sub
 
Function EnumFichiers(Chemin As String, Extension As String) As String()
 
    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer
 
    'complète le chemin le cas échéant
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
 
    'récupère seulement les fichiers Excel
    Fichier = Dir(Chemin & "*" & Extension)
 
    'boucle sur les fichiers du dossier
    Do While (Len(Fichier) > 0)
 
        I = I + 1
 
        ReDim Preserve TableauFichiers(1 To I)
 
        TableauFichiers(I) = Fichier
 
        Fichier = Dir()
 
    Loop
 
    'retourne le tableau des noms de fichiers
    EnumFichiers = TableauFichiers()
 
End Function

Bonjour,
A condition que le nombre des étiquettes de colonnes soit le même et que l'orthographe du nom de celles-ci soit identique, voici une procédure dans cette contribution Regrouper plusieurs feuilles sur une autre. (2003-2010) et un exemple pour des feuilles se trouvant dans des classeurs différents.