Bonjour à tous,
J'ai un dossier qui contient plusieurs fichiers Excel.
Je lis chacun de ces fichiers de ce dossier afin de pouvoir
récupérer les données d'un onglet spécifique.
Voici mon code
Option Explicit
Option Base 1
Sub importCellules_ClasseursFermes()
'
'Necessite d'activer la reference Microsoft ActiveX Data Object 2.x Library
'
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim ADOCmd As ADODB.Command
Dim Fichier As String, Direction As String
Dim Repertoire As String, Feuille As String
Dim X As Integer, NbFichiers As Integer, i As Integer
Dim Tableau() As String
Dim Cellule()
'Nom de répertoire à changer: mettre l'emplacement ou se trouve le fichier exemple
Repertoire = "C:\documents and Settings\repFicExemple"
'Boucle pour lister tous les classeur du repertoire cible
Direction = Dir(Repertoire & "\*.xls" )
Do While Len(Direction) > 0
NbFichiers = NbFichiers + 1
ReDim Preserve Tableau(1 To NbFichiers)
Tableau(NbFichiers) = Direction
Direction = Dir()
Loop
'adresse des cellules contenant les valeurs à recuperer
Cellule = Array("A15", "D15", "E15", "F15" )
'Je n'arrive pas à récupérer plusieurs lignes
'tous les classeurs fermés doivent contenir un onglet nommé "Feuil1"
Feuille = "Feuil1$" 'ne pas oublier d'ajouter $ au nom de la feuille
If NbFichiers > 0 Then
For X = 1 To NbFichiers 'boucle sur les classeurs
'pour ne pas prendre en compte le classeur contenant la macro
If Tableau(X) <> ThisWorkbook.Name Then
Cells(X, 1) = Tableau(X)
Fichier = Repertoire & "\" & Tableau(X)
Set Source = New ADODB.Connection
Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
For i = 1 To UBound(Cellule)
Set ADOCmd = New ADODB.Command
With ADOCmd
.ActiveConnection = Source
'les données sont dans la "Feuil1" des classeurs fermés
.CommandText = _
"SELECT * FROM `" & Feuille & Cellule(i) & ":" & Cellule(i) & "`"
End With
Set Rst = New ADODB.Recordset
Rst.Open ADOCmd, , adOpenKeyset, adLockOptimistic
Set Rst = Source.Execute("`" & Feuille & _
Cellule(i) & ":" & Cellule(i) & "`" )
Cells(X, i + 1) = Rst.Fields(0).Value
Rst.Close
Set Rst = Nothing
Set ADOCmd = Nothing
Next i
Source.Close
Set Source = Nothing
End If
Next X
End If
End Sub
Voici ce qu'il donne actuellement:
NomDuFichier1 ValCellA15 ValCellD15 ValCellE15 ValCellF15
NomDuFichier2 ValCellA15 ValCellD15 ValCellE15 ValCellF15
NomDuFichier3 ValCellA15 ValCellD15 ValCellE15 ValCellF15
...etc
J'affiche donc le nom de mon fichier suivi des 4 cellules que j'ai spécifié ici dans mon code:
Cellule = Array("A15", "D15", "E15", "F15" )
En fait je voudrai récupérer plus que ces 4 cellules de mon fichier.
Voici comment ces données sont organisées dans mon fichier:
A15 D15 E15 F15 H15 J15 K15 L15
A17 D17 E17 F17 H17 J17 K17 L17
A19 D19 E19 F19 H19 J19 K19 L19
Voici ma question:
En l'état actuel du code comment puis-je faire pour obtenir une organisation des données comme cela:
NomDuFichier1 1 A15 D15
NomDuFichier1 2 A15 E15
NomDuFichier1 3 A15 F15
NomDuFichier1 1 A17 D17
NomDuFichier1 2 A17 E17
NomDuFichier1 3 A17 F17
NomDuFichier1 1 A19 D19
NomDuFichier1 2 A19 E19
NomDuFichier1 3 A19 F19
NomDuFichier1 1 H15 J15
NomDuFichier1 2 H15 K15
NomDuFichier1 3 H15 L15
NomDuFichier1 1 H17 J17
NomDuFichier1 2 H17 K17
NomDuFichier1 3 H17 L17
NomDuFichier1 1 H19 J19
NomDuFichier1 2 H19 K19
NomDuFichier1 3 H19 L19
...etc pour les autres fichiers
Merci à tous pour votre aide
