macro recherche qui bloque avec 40000 lignes

Private Sub UserForm_Initialize()
Dim O As Worksheet 'déclare la varibale O (Origine)
Dim C As Worksheet 'déclare la variable C (Cible)
Dim ORang 'déclare la variable ORang
Dim CRang 'déclare la variable CRang
Dim CelO, CelC As Long 'déclare les variable CelO et CelC
Dim X As Long 'déclare la variable x

Set O = Sheets('liste') 'définit la variable O
Set C = Sheets('base peche') 'définit la variable C
ORang = O.Range('A2:A' & O.Range('A65536').End(xlUp).Row) 'définit la variable O Rang
CRang = C.Range('f17:j' & C.Range('f65536').End(xlUp).Row) 'définit la variable CRang
ListBox1.ColumnCount = 3

ListBox1.ColumnWidths = '80;180;80'
X = 0 'définit la variable x
For Each CelO In ORang 'boucle sur toutes les cellule de la plage ORang
       
        If Not CelO = '' Then 'condition : si la cellule n'est pas vide
               
                For CelC = 1 To UBound(CRang) 'boucle sur toutes les cellule de la plage CRang
                        'si les cellules sont identiques, va à la balise 'Suite'
                        If CelO = CRang(CelC, 1) Then GoTo suite
                Next CelC 'prochaine cellule de la plage CRang
                ListBox1.AddItem CelO 'ajoute la valeur de la cellule CelO à la ListBox1
                ListBox1.Column(1, X) = CRang(CelC - 1, 2) 'ajoute la valeur de la cellule adjacente à Celo
                ListBox1.Column(2, X) = CRang(CelC - 1, 5) 'ajoute la valeur de la cellule adjacente à Celo
                X = X + 1 'redéfinit la variable x
        End If 'fin de la condition

suite: 'balise
Next CelO 'prochaine cellule de la plage ORang

End Sub

Cliquez pour agrandir...