Recherche dans un dossier avec sous dossiers + extraction des données ciblées

harrywallez Messages postés 4 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 11 août 2009 - 25 mai 2009 à 15:23
harrywallez Messages postés 4 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 11 août 2009 - 25 mai 2009 à 15:42
Bonjour à vous tous, qui m'avez déja sauvé la vie plus d'une fois...
Apres de nombreuses recherches infructueuses, je pose ma question dans le forum :

Débutant en VBA, je cherche à créer une macro qui puisse :
-chercher des fichiers .xls dans un dossier et ses sous dossier, en filtrant non pas le nom du fichier (car il est variable), mais par le type d'infos contenues dans le .xls (typiquement une valeur de cellule qui sera toujours la même)
-extraire les données ciblées et les coller dans une autre classeur.

J'ai trouvé ce code, mais il ne correspond pas tout à fait à mes attentes car il ne fait qu'extraire des donnés de fichiers contenus dans le même répertoire :

(source : http://frederic.sigonneau.free.fr/Ado.htm)
-------------------------------------------------

Attribute VB_Name = "ValeursDansClasseursFermes"

'récupère dans une série de classeurs fermés (dans le même répertoire)
'les valeurs d'une plage et les écrit dans la feuille active

Sub LoopThruFiles()
'Ron De Bruin, mpep
Dim place As String
Dim FilesArray() As String, FileCounter As Integer
Dim FName As String, LoopCounter As Integer

FName = Dir("c:\*.xls")
Do While Len(FName) > 0
FileCounter = FileCounter + 1
ReDim Preserve FilesArray(1 To FileCounter)
FilesArray(FileCounter) = FName
FName = Dir()
Loop
If FileCounter > 0 Then
Application.ScreenUpdating = False
For LoopCounter = 1 To FileCounter

x = LoopCounter
'calcul de la plage de destination
place = Range(Cells((((x - 1) * 10) + 2), 1), Cells(((x * 10)), 3)).Address
GetValues "c:", FilesArray(LoopCounter), "Blad1", "a1:c10", place
Next
Application.ScreenUpdating = True
End If
End Sub

Sub GetValues(fPath As String, FName As String, sName, _
cellRange As String, place As String)
'recopie une plage des valeurs externes dans une plage de
'la feuille active sous forme d'une formule matricielle
With ActiveSheet.Range(place)
.FormulaArray = "='" & fPath & "\[" & FName & "]" & sName & "'!" & cellRange
.Value = .Value
End With
End Sub

-------------------------------------------------

1 réponse

harrywallez Messages postés 4 Date d'inscription mardi 26 mai 2009 Statut Membre Dernière intervention 11 août 2009
25 mai 2009 à 15:42
je viens de me rendre compte que le code mis en exemple était tres mal passé, mais je ne sais pas comment faire pour qu'il conserve une forme harmonieuse...désolé.
Merci d'avance
0
Rejoignez-nous