nmyzz
Messages postés1Date d'inscriptionmercredi 22 mai 2019StatutMembreDernière intervention22 mai 2019
-
22 mai 2019 à 10:30
Bonjour la communauté,
Je suis nouveau sur ce forum et je galère avec un point VBA sur excel.
Ce que je souhaite faire c'est
Pour chaque onglet de mon fichier excel n°1
Construire une chaîne de caractère = <Constante> + nom de l'onglet
Pour chaque onglet d'un fichier excel n°2
Pour chaque occurrence trouvée de la chaîne de caractère
Récupérer la valeur de la cellule à droite de l'occurence
Reporter cette valeur dans l'onglet courant de mon fichier excel n°1
Fin
Fin
Fin
Pour le moment j'arrive à récupérer une seule occurrence mais je ne parvient pas à gérer les occurences multiples (utilisation de FindNext ou boucle while avec Find).
Voici mon code actuel :
'#########################################
'##### Recherche dans fichier Exccel #####
'#########################################
Sub Valeur_cherchee()
'Initialisation des variables
Dim Destination As Workbook
Dim Source As Workbook
Dim Trouve As Range
Dim SearchCell As Range
Dim Cell As Range
Dim ValeurCherche As Range
Dim CellTmpRecherche As Range
Dim Ok As Boolean
'Sélection du fichier si paramètre non renseigné
If IsEmpty(ThisWorkbook.Sheets("AdminCompte").Range("A2")) Then
SelectFile
End If
'Selection d'une colonne de rechercher dans le fichier excel source
If IsEmpty(ThisWorkbook.Sheets("AdminCompte").Range("A5")) Then
SetConstante
End If
Set ValeurCherche = ThisWorkbook.Sheets("AdminCompte").Range("A5")
'Remplissage des variables
Set Destination = ThisWorkbook
Set Source = Workbooks.Open(ThisWorkbook.Sheets("AdminCompte").Range("A2"))
Application.ScreenUpdating = False
For i = 1 To Destination.Sheets.Count
Set Cell = Destination.Sheets(i).Range("A1")
For j = 1 To Source.Sheets.Count
Set Trouve = Source.Sheets(j).Cells.Find(What:="Test " & Destination.Sheets(i).Name, LookAt:=xlPart)
If Trouve Is Nothing Then
'MsgBox "La Valeur " & "Test " & Destination.Sheets(i).Name & " n'a pas été trouvée"
Else
Set SearchCell = Source.Sheets(j).Cells.Find(What:=ValeurCherche.Value, LookAt:=xlPart)
' Selectionne la première cellule du tableau Range("A1").Select
Cell = Source.Sheets(j).Cells(Trouve.Row, SearchCell.Column)
Set Cell = Cell.Offset(1, 0)
End If
Next
Set Cell = Destination.Sheets(i).Range("A1")
Next
Application.ScreenUpdating = True
Source.Close
Destination.Activate
Set Destination = Nothing:
Set Source = Nothing:
MsgBox "Copie des données terminée"
End Sub
'##################################
'##### Sélection d'un fichier #####
'##################################
Sub SelectFile()
myFile = Application.GetOpenFilename(, , "Browse for workbook")
ThisWorkbook.Sheets("AdminCompte").Range("A2") = myFile
End Sub
'##################################
'##### Saisie d'une constante #####
'##################################
Sub SetConstante()
Valeur = InputBox("Saisir la chaîne recherchée", "Chaîne recherchée ...")
If StrPtr(Valeur) = 0 Then
MsgBox "Action Annulée"
Exit Sub
End If
ThisWorkbook.Sheets("AdminCompte").Range("A5") = Valeur
End Sub