louisic
Nouveau membre
Bonjour à tous,
Je travail avec Office 2010 et je cherche à produire une macro qui me permettrait de chercher dans plusieurs fichier d'un même dossier, à partir d'un autre fichier, une valeur variable inscrite dans la colonne précédent une valeur fixe et importé l'intégralité des lignes contenant cette valeur variable dans la colonne "C".
Ex :
Dans le fichier « A », situé dans le dossier « Y », j’exécute la macro et je cherche la valeur « surv. ».
Dans le fichier « B », situé dans le dossier « X »,se trouve la valeur « surv. » en G14. J’importe alors l’entête du fchier « B » se trouvant en (B3:E7) et je prends F14 que je recherche dans la colonne C du fichier « B ». J’importe alors toutes les lignes du fichier « B », ayant cette valeur en «C 20» à « C120 », dans le fichier « A » feuille 2. Ainsi de suite pour le fichier « C, D, E, … » contenu dans le Dossier « X ».
Voilà ou j’en suis :
Merci de votre aide!
Je travail avec Office 2010 et je cherche à produire une macro qui me permettrait de chercher dans plusieurs fichier d'un même dossier, à partir d'un autre fichier, une valeur variable inscrite dans la colonne précédent une valeur fixe et importé l'intégralité des lignes contenant cette valeur variable dans la colonne "C".
Ex :
Dans le fichier « A », situé dans le dossier « Y », j’exécute la macro et je cherche la valeur « surv. ».
Dans le fichier « B », situé dans le dossier « X »,se trouve la valeur « surv. » en G14. J’importe alors l’entête du fchier « B » se trouvant en (B3:E7) et je prends F14 que je recherche dans la colonne C du fichier « B ». J’importe alors toutes les lignes du fichier « B », ayant cette valeur en «C 20» à « C120 », dans le fichier « A » feuille 2. Ainsi de suite pour le fichier « C, D, E, … » contenu dans le Dossier « X ».
Voilà ou j’en suis :
Code:
Sub Recherche_ligne()
Dim Dossier As String
Dim Fichier_X As String
Dim Fichier_A As String
Dim MyFind As Variant
Dim FoundCell As Object
Dim Counter As Long
' ---------------------------------
MyFind = "surv."
If MyFind = "" Then End
Counter = 0
Fichier_A = "Fichier_A.xls"
On Error Resume Next
'------------------------------------------------
Set FS = CreateObject("Scripting.FileSystemObject")
'Dans le dossier Y
Set Dossier_Y = FS.GetFolder
'Dans les Fichiers ".XLS"
Set Fichier_X = Dossier.Files
'Dans la feuille 1
Set ws = Worksheets("Feuil1")
Do
Workbooks.Open Fichier_X
Set FoundCell = ws.Cells.Find(what:=MyFind)
If Not FoundCell Is Nothing Then
FirstAddress = FoundCell.Address
Do
Counter = Counter + 1
FoundCell.EntireRow.Copy Destination:=Sheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
ThisWorkbook.ws.Cells.FindNext(FoundCell)
Loop While Not FoundCell Is Nothing And FoundCell.Address <> FirstAddress
End If
Loop While Fichier <> ""
rsp = MsgBox(Counter & " Résultats trouvés")
End SubMerci de votre aide!
, des approximations :/ , et aussi des erreurs grossières 
)
