[XL-2003] recopier des lignes dans différents fichiers [Résolu]

[fortbelin]

Bonjour à tous

J'ai besoin d'aide pour un problème pas très compliqué mais je suis pas un pro de vba.

J'ai plusieurs fichiers Excel avec pour chacun des entêtes de colonnes et des lignes de réponses.
Je voudrais donc pouvoir recopier dans un nouveau fichier toutes ces lignes de données les unes à la suite des autres sans bien sur ouvrir les fichiers d'origine.

Merci beaucoup

[Theze]

Bonjour,

Essai ceci, mais adapte d'abords le nom de la feuille (il doit être le même pour toutes les feuilles y compris celle où vont être récupérées les valeurs, dans l'exemple, "Feuil1") et le chemin du dossier. La feuille de récup doit avoir une ligne d'entêtes. Adapte aussi la plage, dans l'exemple, de A à D :

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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
 
Private Sub ConnectCLasseur(ConnectCL As Object, _
                            Fichier As String, _
                            Optional Rs)
 
    Set ConnectCL = CreateObject("ADODB.Connection")
 
    If Not IsMissing(Rs) Then
        Set Rs = CreateObject("ADODB.Recordset")
    End If
 
    ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & Fichier & ";" & _
              "Extended Properties=""Excel 8.0;HDR=NO;IMEX= 2;"""
 
End Sub
 
Sub RecupValeurs()
 
    Dim ConnectCL As Object
    Dim Rs As Object
    Dim Champ As Object
    Dim Tableau()
    Dim TblFichiers() As String
    Dim Classeur As String
    Dim NomFeuille As String
    Dim Dossier As String
    Dim Plage As String
    Dim DerCel As Integer
    Dim Test As Integer
    Dim I As Integer
    Dim J As Integer
    Dim K As Integer
 
    Dossier = "D:\Dossier Excel\"
    'chemin du classeur cible
 
    TblFichiers() = Classeurs(Dossier)
 
    On Error Resume Next
    Test = UBound(TblFichiers)
 
    If Err.Number <> 0 Then
 
        MsgBox "Aucun fichier Excel dans le dossier !"
        Err.Clear
        Exit Sub
 
    End If
 
    For K = 1 To Test
 
        Classeur = Dossier & TblFichiers(K)
 
        'nom de la feuille où se trouve la plage
        'adapter le nom mais la feuille de récup doit être nommée pareil que les autres !)
        NomFeuille = "Feuil1"
 
        'défini la plage sur la colonne A pour la recherche du nombre
        'de cellules non vides
        Plage = "A1:A65536" 'adapter l'adresse
 
        'ouvre une première connecxion pour la recherche
        ConnectCLasseur ConnectCL, Classeur, Rs
 
        'défini la dernière ligne non vide de la colonne A
        Set Rs = ConnectCL.Execute("SELECT COUNT(*) FROM `" & NomFeuille & "$" & Plage & "` ")
        DerCel = Rs.Fields(0).Value
 
        'plage à récupérer, doit être définie comme "Xx:Xx"
        Plage = "A1:D" & DerCel
 
        'ferme le Recordset
        Rs.Close
 
        'puis le réouvre pour inscrire la valeur
        With Rs
 
            .CursorType = 1
            .LockType = 3
            .Open "SELECT * FROM `" & NomFeuille & "$" & Plage & "` ", ConnectCL
            .MoveFirst
 
            ReDim Tableau( _
                1 To .RecordCount, _
                1 To .Fields.Count)
 
            Do While Not .EOF
 
                I = I + 1
 
                For Each Champ In .Fields
                    J = J + 1
                    Tableau(I, J) = Champ.Value
                Next
 
                J = 0
 
                .MoveNext
 
            Loop
 
            I = 0
 
        End With
 
        ConnectCL.Close
        'Stop
        'inscrit dans "NomFeuille" du classeur actif et la vide
        With ThisWorkbook.Worksheets(NomFeuille)
 
            DerCel = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Range(.Range("A" & DerCel), .Cells(UBound(Tableau, 1) + DerCel - 1, UBound(Tableau, 2))).Value = Tableau
 
        End With
 
        Erase Tableau
 
    Next K
 
    Set Rs = Nothing
    Set ConnectCL = Nothing
 
End Sub
Function Classeurs(Chemin As String) As String()
 
    Dim Tbl() As String
    Dim Fichier As String
    Dim I As Integer
 
    Fichier = Dir(Chemin)
 
    Do While (Len(Fichier) > 0)
 
        'seuls les fichiers Excel
        If InStr(Fichier, ".xls") <> 0 Then
 
            I = I + 1
            ReDim Preserve Tbl(1 To I)
            Tbl(I) = Fichier
 
        End If
 
        Fichier = Dir()
 
    Loop
 
    Classeurs = Tbl()
 
End Function

Hervé.

[Theze]

Re,

Il est préférable de communiqué en public et non en MP, de cette façon, tout le monde peut profiter de la discussion et éventuellement intervenir.
Ta plage doit être entrée de cette façon : "A22:D" & DerCel et le résultat ressemblera à ça : A22:D55
Apparemment, tu défini ta plage de cette façon "A22" & DerCel ce qui ne peut pas fonctionner.

Tiens moi au courant.

Hervé.

[fortbelin]

Bonjour,

merci pour votre aide cela marche super.

En fait il ne fallait pas mettre le fichier récapitulatif dans le même dossier que les autres sinon la macro recopiait également les lignes du fichier récapitulatif.

Merci encore et bonne journée.

Christophe