EXCEL : Recherche occurrence multiple VBA

Fermé
nmyzz Messages postés 1 Date d'inscription mercredi 22 mai 2019 Statut Membre Dernière intervention 22 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


A voir également: