Sub testCollection()
    Dim col As New Collection
    Dim rngFound As Range
    Dim rgn As Range
  
    Application.ScreenUpdating = False
    Application.FindFormat.Locked = True
    Application.FindFormat.FormulaHidden = False
  
' Boucle tant que pour rechercher toutes les cellules correspondantes
        Do
            ' Recherche les cellules répondant aux conditions spécifiées
                Set rngFound = Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
                    xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
          
            ' Si une cellule correspondante est trouvée, l'activer
                If Not rngFound Is Nothing Then
                    ' Ajoute la première cellule trouvée à la collection
                        rngFound.Activate
                        If Exists(col, CStr(rngFound.Address)) Then
                            Exit Do
                        Else
                            col.Add key:=CStr(rngFound.Address), Item:=rngFound
                            If rgn Is Nothing Then
                                Set rgn = rngFound
                            Else
                                Set rgn = Union(rgn, rngFound)
                            End If
                        End If
            End If
        Loop While Not rngFound Is Nothing
'
    Application.ScreenUpdating = True
' Selection
    rgn.Select
End Sub
Function Exists(ByRef col As Collection, ByVal key As String) As Boolean
' Le code suivant vérifie si une clé existe
    On Error GoTo EH
    IsObject (col.Item(key))
    Exists = True
EH:
End Function