tri de classeurs par données de cellules

[Morkrock]

Donc me revoilà avec un sujet plus précis... :unsure:

My problem :
Je dispose d'une liste précise de classeurs (en tout 438) comportant le chemin exact de chacun d'eux ('C:\\dossierA\\sousdossierX\\soussousdossierY\\nomfichier.xls' sachant que A est fixe alors que X et Y sont variables).
Je souhaite trier ces classeurs suivant 2 données qui se trouvent dans chaque classeur sur la même feuille (même nom) et même cellules, à savoir la cellule B2 (un nombre de 1 à 14) et la cellule D1 (date au format jj:mm:aaaa).
L'idéal serait de faire ce tri sans ouvrir physiquement les classeurs...
Enfin, la sélection des classeurs souhaités lancerait une macro simple que je sais réaliser...
Je n'ai pas suffisamment de connaissances en VBA pour tout ça et je fais appel à vous...
Merci

 

[MichelXld]

bonsoir

j'espere que cet exemple pourra t'aider


Sub importDonnees()
'necessite d'activer la reference Microsoft ActiveX Data Objects x.x Library
Dim Fichier As String, Plage As String, Feuille As String
Dim Cn As ADODB.Connection
Dim Cmd As ADODB.Command
Dim Rs As ADODB.Recordset
Dim Cell As Range

Feuille = 'Feuil1' 'nom de la feuille dans les classeurs fermés
Plage = 'B12' 'plage de cellule qui contient (entre autre) les données cible

'boucle sur les noms de fichiers qui sont dans la colonne A du classeur
For Each Cell In Range('A1:A' & Range('A1').End(xlDown).Row)
Fichier = Cell

Set Cn = New ADODB.Connection
Cn.Open 'Provider=Microsoft.Jet.OLEDB.4.0;' & _
'Data Source=' & Fichier & ';Extended Properties=''Excel 8.0;HDR=No;'';'

Set Cmd = New ADODB.Command
With Cmd
.ActiveConnection = Cn
.CommandText = 'SELECT * FROM `' & Feuille & '$' & Plage & '`'
End With

Set Rs = New ADODB.Recordset
Rs.Open Cmd, , adOpenKeyset, adLockOptimistic

Set Rs = Cn.Execute('`' & Feuille & '$' & Plage & '`')

With Rs
.Move (0)
Cell.Offset(0, 1) = .Fields(2).Value 'recuperation donnée cellule D1
.Move (1)
Cell.Offset(0, 2) = .Fields(0).Value 'recuperation donnée cellule B2
End With

Rs.Close
Cn.Close
Next
End Sub


bone soiree
MichelXld

 

[Morkrock]

merci de ce tuyau, je cours l'essayer...