Optimisation Recherche base de données

Bonjour amis VBA,

j'ai un petit souci...surement dû à la lourdeur de mon code.

En mode step by step (debug)...tout fonctionne, mais quand je le lance normalement, Excel crash.
Je dois comparer une liste de pièces (environ 150 lignes) sur une base de données d'environ 5000 lignes qui se trouve dans un autre fichier. J'ai créé des fonctions pour faire deux tableau "virtuels" mais il me semble qu'au lieu d'accélérer le processus...ça le ralenti.

J'èspere avoir été assez claire.

Merci beaucoup pour votre aide :D

Voilà mon code:

Sub recherche_ITEM() 'Programme de recherché

For i = 0 To UBound(tab_BOM)
    For j = 0 To UBound(tab_ITEM)
        If (tab_BOM(i, 0)) = (tab_ITEM(j, 0)) Then Exit For
    Next j
        If j > UBound(tab_ITEM) Then
        
            Call CopieCellule_nonExist(i)
        Else
            Call CopieCellule_Exist(j + 2, i)
        End If
Next i
End Sub

Function tab_ITEM() As Variant 'Rempli un tableau avec tout les ITEM de la DataBase ITEM_compilation_test.xlsx

Dim tab1() As Variant
Dim lastRow, i, j As Long

Application.ScreenUpdating = False
Windows("ITEM_Compilation_test.xlsx").Activate
lastRow = Worksheets("Compilation ITEM").Range("A" & Rows.Count).End(xlUp).Row - 1

ReDim tab1(lastRow, 2)

For i = 0 To UBound(tab1)
    tab1(i, 0) = Worksheets("Compilation ITEM").Range("A" & i + 2)
    tab1(i, 1) = Worksheets("Compilation ITEM").Range("B" & i + 2)
    tab1(i, 2) = Worksheets("Compilation ITEM").Range("K" & i + 2)
Next i
tab_ITEM = tab1
ThisWorkbook.Worksheets("Validation BOM").Activate
End Function

Function tab_BOM() As Variant 'Rempli un tableau avec tout les ITEM de la BOM

Dim tab1() As Variant
Dim lastRow, i As Long

Application.ScreenUpdating = False
ThisWorkbook.Activate
lastRow = Range("B" & Rows.Count).End(xlUp).Row - 2

ReDim tab1(lastRow, 2)

For i = 0 To UBound(tab1)
    tab1(i, 0) = ThisWorkbook.Worksheets("Validation BOM").Range("C" & i + 3)
    tab1(i, 1) = ThisWorkbook.Worksheets("Validation BOM").Range("D" & i + 3)
    tab1(i, 2) = ThisWorkbook.Worksheets("Validation BOM").Range("E" & i + 3)
Next i
tab_BOM = tab1
End Function

Sub CopieCellule_nonExist(Param1 As Variant) 'Si non existant, copie la ligne et la colle dans la DataBase

    Dim Départ, Destination
    Dim LigneDestination
    Set Destination = Workbooks("ITEM_Compilation_test.xlsx").Worksheets("Compilation ITEM") 'Feuille d'arrivée
    
    Destination.Activate
    LigneDestination = Destination.Range("A1048576").End(xlUp).Row + 1
    Destination.Range("A" & LigneDestination) = tab_BOM(Param1, 0)
    Destination.Range("B" & LigneDestination) = tab_BOM(Param1, 1)
    Destination.Range("K" & LigneDestination) = tab_BOM(Param1, 2)
    ThisWorkbook.Worksheets("Validation BOM").Activate   
End Sub

Sub CopieCellule_Exist(ligne_destination As Long, Param1 As Variant) 'Si existant, copie la cellule "statut" et la colle dans la DataBase

    Dim Départ, Destination
    Dim LigneDestination
    Set Destination = Workbooks("ITEM_Compilation_test.xlsx").Worksheets("Compilation ITEM") 'Feuille d'arrivée
    
    Destination.Activate
    LigneDestination = Destination.Range("A" & ligne_destination).Row
    Destination.Range("K" & LigneDestination) = tab_BOM(Param1, 2)
    ThisWorkbook.Worksheets("Validation BOM").Activate
End Sub

Sub recherche_fournisseur() 'Ouverture du fichier "ITEM compilation test.xlsx

On Error Resume Next ' Si une erreur est renvoyée, fichier non ouvert
     Windows("ITEM_Compilation_test.xlsx").Activate
If Err.Number <> 0 Then   'j'ouvre le fichier
     Workbooks.Open Filename:=("C:\Users\fza\Desktop\Processus_CFSI\ITEM_Compilation_test.xlsx")
        Windows("ITEM_Compilation_test.xlsx").Activate
End If
On Error GoTo 0
Call recherche_ITEM

End Sub