Extraction de la fonction recherche (Contrôle + F)

Bonjour,

Y-a-t-il un moyen d'extraire les données que la fonction recherche ( contrôle+F ) nous permet d'obtenir ?

Par exemple, je cherche une valeur flottante dans tout mon classeur et obtiens un résultat de 100 éléments trouvés, grâce au contrôle F j'obtiens la feuille, la cellule et la valeur de chaque éléments trouvés, exemple : je cherche "628???" (les ? me permettent de dire qu'il y a des valeur que je ne connais pas et excel me sort tout les éléments où les premiers caractères sont 628 ) et la fenêtre rechercher me montre la feuille, la cellule et la valeur pour chaque éléments trouvés. Je recherche alors un moyen d'extraire dans une feuille Excel toutes les données trouvées. En essayant d'utiliser VBA je me suis perdu et malheureusement chatGPT n'a pas l'air de comprendre. Les formules ne permettent pas vraiment de rechercher dans tout le classeur et encore moins de vérifier chaque cellule de chaque feuille.

Alors connaissez-vous un moyen d'extraire toutes ces données ( avec VBA ou simplement sur excel ) ?

Bonjour,

Solution VBA. Nommez "Destination" la feuille qui doit collecter les informations.

Puis copiez ce bout de code:

Option Explicit

Sub Rechercher()
    'Création des variables
    Dim f1 As Worksheet, f2 As Worksheet
    Dim i As Long, j As Long, Lig_Dest As Long, Cpt As Long
    Dim Valeur As Double
    Dim Deb As String
    Dim X As Object

    Application.ScreenUpdating = False
    Set f1 = Sheets("Destination")
    f1.Cells.ClearContents
    Valeur = Application.InputBox("Indiquez la valeur à rechercher", , , , , , , 1)
    Lig_Dest = 2
    Cpt = 0
    ReDim Tabl(0)
    For i = 1 To Sheets.Count 'on passe sur toutes les feuilles
        If Sheets(i).Name <> "Destination" Then ''on si ce n'est pas la feuille de destination, alors:
            Set f2 = Sheets(Sheets(i).Name) 'on mémorise son nom
            With f2.Cells 'on fait la recherche dans la feuille entière
                Set X = .Find(Valeur, lookat:=xlPart) 'Valeur recherchée
                If Not X Is Nothing Then 'Si la valeur est trouvée, alors:
                    Deb = X.Address 'on mémorise la première adresse
                    Do
                        Tabl(Cpt) = Array(f2.Name, X.Address, X)
                        Set X = .FindNext(X) 'on cherche la présence de cette valeur dans la même feuille
                        Cpt = Cpt + 1
                        ReDim Preserve Tabl(Cpt)
                    Loop While Not X Is Nothing And X.Address <> Deb 'si la valeur est trouvée et que son adresse est différente de la première adresse alors on recommence
                End If
            End With
        End If
    Next i
    For j = 0 To Cpt - 1
        Range(f1.Cells(Lig_Dest, "A"), f1.Cells(Lig_Dest, "C")) = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(Tabl(j)))
        Lig_Dest = Lig_Dest + 1
    Next j
    f1.Range("A1:C1").Value = Array("Feuilles", "Adresses", "Valeurs")

    'on libère la mémoire
    Set X = Nothing
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt

Merci infiniment cela marche à merveille.

Cordialement