Bonsoir,
La macro "Comment fusionner tous les classeurs fermés ..." donnée par SilkyRoad dans les FAQ excel correspond exactement à mon besoin. mais j'obtiens sur la ligne :
l'erreur suivante :
Code : Sélectionner tout - Visualiser dans une fenêtre à part Rs.Open Cible, xConnect, adOpenStatic, adLockOptimistic, adCmdText
Débutant en VBA, mes notions se limitent à utiliser des routines du site.Erreur d'execution '-2147217887(80040e21)
Ce pilote ODBC ne prend pas en charge les propriétés demandées.
Je ne sais pas du tout interpréter cette erreur.
Ci dessous la 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 Sub rassemble() ' ' rassemble Macro ' Macro enregistrée le 10/12/2011 par ''Nécessite d'activer la référence 'Microsoft ActiveX Data Objects x.x Library Dim Cn As ADODB.Connection Dim Rs As ADODB.Recordset Dim xConnect As String, Cible As String Dim Fichier As String, Dossier As String, Feuille As String Dim i As Long 'nom du répertoire contenant les classeurs à regrouper Dossier = "C:\test" 'Nom de la feuille dans les classeurs fermés 'Ne pas oublier le symbole $ après le nom de la feuille Feuille = "Données$" i = 2 Fichier = Dir(Dossier & "\*.xls") 'boucle sur les fichiers du repertoire Do While Len(Fichier) > 0 xConnect = "DRIVER={Microsoft Excel Driver (*.xls)};" & _ "ReadOnly=1;DBQ=" & Dossier & "\" & Fichier 'connection classeur Set Cn = New ADODB.Connection Cn.Open xConnect 'Requete Cible = "SELECT * FROM [" & Feuille & "];" Set Rs = New ADODB.Recordset Rs.Open Cible, xConnect, adOpenStatic, adLockOptimistic, adCmdText 'Ecriture dans la feuille de calcul If Not Rs.EOF Then Cells(i, 1).CopyFromRecordset Rs i = Cells(i, 1).End(xlDown).Row + 1 Rs.Close Cn.Close Set Cn = Nothing Set Rs = Nothing Fichier = Dir() Loop MsgBox "Terminé" End Sub
Merci pour une aide bienveillante.
Partager