Recherche sur plusieurs Feuilles

Bonjour le forum,

J'aimerais une macro capable de faire une recherche sur plusieurs feuilles d'une référence mise en A1 de la feuille 1.

Ci joint un exemple avec tous les détails.

D'avance merci pour votre aide.

Bonjour,

Un exemple qui ne colore rien, mais retourne les adresses :

Option Explicit

Sub RechercheMultiPages()
Dim Resultat As String
    Resultat = Cherche(ThisWorkbook, Sheets("Feuil1").Range("A1").Value)
    MsgBox Resultat
End Sub

Private Function Cherche(Wb As Workbook, strValue As String) As String
Dim rngTemp As Range, strResult As String, wsh As Variant
    For Each wsh In Wb.Worksheets
        With wsh.Cells
            Set rngTemp = .Find(strValue)
            If Not rngTemp Is Nothing Then
                If strResult = vbNullString Then
                    strResult = vbTab & "--> " & rngTemp.AddressLocal(0, 0, xlA1, True)
                Else
                    strResult = strResult & vbCrLf & vbTab & "--> " & rngTemp.AddressLocal(0, 0, xlA1, True)
                End If
            End If
        End With
    Next
    If strResult = vbNullString Then
        strResult = "Aucune occurence de la référence : " & strValue & " n'a été trouvée."
    Else
        strResult = "La référence : " & strValue & " a été trouvée aux adresses suivantes : " & vbCrLf & strResult
    End If
    Cherche = strResult
End Function

Autre solution qui, elle, renvoie des objets Range dans une collection :

Option Explicit

Sub RechercherRange()
Dim collRanges As New Collection, item As Variant
    Set collRanges = ChercheRange(ThisWorkbook, Worksheets("Feuil1").Range("A1").Value, "Feuil1", "Feuil14")
    For Each item In collRanges
        MsgBox item.AddressLocal(0, 0, xlA1, True)
    Next item
End Sub

Private Function ChercheRange(Wb As Workbook, What As String, ParamArray Feuilles_A_Eviter()) As Collection

    'PARAMETRES :
    '   > Wb As Workbook : le classeur dans lequel chercher
    '   > What As String : La valeur à chercher
    '   > ParamArray Feuilles_A_Eviter() : Le cas échéant, renseigner des noms de feuilles dans lesquelles ne pas chercher

Dim wshFeuil As Worksheet, rngTemp As Range, collResultat As New Collection, strPremiere As String, bFlag As Boolean, i As Integer
    For Each wshFeuil In Wb.Worksheets
        bFlag = True
        For i = 0 To UBound(Feuilles_A_Eviter)
            If Feuilles_A_Eviter(i) = wshFeuil.Name Then bFlag = False: Exit For
        Next
        If bFlag Then
            With wshFeuil.Cells
                Set rngTemp = .Find(What)
                If Not rngTemp Is Nothing Then
                    collResultat.Add rngTemp, rngTemp.AddressLocal(0, 0, xlA1, True)
                    strPremiere = rngTemp.Address
                    Do
                        Set rngTemp = .FindNext(rngTemp)
                        If rngTemp Is Nothing Then
                            GoTo Suite
                        Else
                            On Error Resume Next
                            collResultat.Add rngTemp, rngTemp.AddressLocal(0, 0, xlA1, True)
                            On Error GoTo 0
                        End If
                    Loop While rngTemp.Address <> strPremiere
                End If
Suite:
            End With
        End If
    Next
    Set ChercheRange = collResultat
    Set collResultat = Nothing
End Function

Merci beaucoup Pijaku, est-il possible de sélectionner directement la case concerné ?

Merci beaucoup pour ton aide

Bonjour,

Colore la police de toutes les occurrences trouvées dans toutes les feuilles, et sélectionne la dernière trouvée.

Si pas trouvée, l'annonce par MsgBox...

What Else?

Sub RechercherRange()
Dim collRanges As New Collection, item As Variant, rngActive As Range
    Set rngActive = ActiveCell
    Set collRanges = ChercheRange(ThisWorkbook, Worksheets("Feuil1").Range("A1").Value, "Feuil1", "Feuil14")
    For Each item In collRanges
        Application.Goto item
        item.Font.ColorIndex = 3
    Next item
    If ActiveCell = rngActive Then MsgBox "La référence : " & Worksheets("Feuil1").Range("A1").Value & " n'a pas été trouvée"
End Sub
Private Function ChercheRange(Wb As Workbook, What As String, ParamArray Feuilles_A_Eviter()) As Collection

    'PARAMETRES :
    '   > Wb As Workbook : le classeur dans lequel chercher
    '   > What As String : La valeur à chercher
    '   > ParamArray Feuilles_A_Eviter() : Le cas échéant, renseigner des noms de feuilles dans lesquelles ne pas chercher

Dim wshFeuil As Worksheet, rngTemp As Range, collResultat As New Collection, strPremiere As String, bFlag As Boolean, i As Integer
    For Each wshFeuil In Wb.Worksheets
        bFlag = True
        For i = 0 To UBound(Feuilles_A_Eviter)
            If Feuilles_A_Eviter(i) = wshFeuil.Name Then bFlag = False: Exit For
        Next
        If bFlag Then
            With wshFeuil.Cells
                Set rngTemp = .Find(What)
                If Not rngTemp Is Nothing Then
                    collResultat.Add rngTemp, rngTemp.AddressLocal(0, 0, xlA1, True)
                    strPremiere = rngTemp.Address
                    Do
                        Set rngTemp = .FindNext(rngTemp)
                        If rngTemp Is Nothing Then
                            GoTo Suite
                        Else
                            On Error Resume Next
                            collResultat.Add rngTemp, rngTemp.AddressLocal(0, 0, xlA1, True)
                            On Error GoTo 0
                        End If
                    Loop While rngTemp.Address <> strPremiere
                End If
Suite:
            End With
        End If
    Next
    Set ChercheRange = collResultat
    Set collResultat = Nothing
End Function

Merci beaucoup Pijaku,

C'est super

Bien à toi