Comparaison fichiers et suppression lignes

Bonsoir,

Je me casse la tête pour adapter le modèle d'une macro qui fonctionne déjà sur un fichier sur un autre fichier.

Pour expliquer, j'ai un fichier sur lequel je met a jour des références de cartons, le n° de la ref est toujours en colonne B.

En parallèle, je reçois toute les semaines le stock global usine qui comporte toutes les ref utilisées en colonne B. Ce fichier n'a jamais le même nom. Je veux donc lancer une macro qui ouvre mon fichier de ref carton et va comparer les 2 fichiers. Dès qu'une ref n'est pas dans mon fichier carton il faut supprimer la ligne.

Le but étant d'avoir un fichier épuré.

Voici le bout de code sur lequel je travaille mais je n'obtiens pas ce que je veux.

Merci par avance

Sub Tri_Carton()
Application.ScreenUpdating = False
Dim DL_Source As Integer
Dim DL_Liste As Integer
Dim i As Integer
Dim j As Integer

DL_Ligne = 1
DL_Source = 1

Dim WbSource As Workbook
Dim WbListe As Workbook

Set WbListe = ActiveWorkbook
Set WbSource = ThisWorkbook

DL_Liste = WbListe.ActiveSheet.Range("B6").End(xlDown).Row
'MsgBox (DL_Liste)
DL_Source = WbSource.Worksheets(1).Range("B1").End(xlDown).Row
'MsgBox (DL_Source)

For i = 6 To DL_Liste
For j = 2 To DL_Source

            If (WbListe.Worksheets(1).Range("B" & i).Value = WbSource.Worksheets(1).Range("B" & j).Value) Then
            'rien  
            Else
            WbListe.Worksheets(1).Rows(i).Delete shift:=xlUp

            End If

Next j
Next i

WbSource.Close

Salut Farenheight69,

et comme ça?

For i = DL_Liste To 6 Step -1   'quand on efface des lignes, on parcourt la boucle à l'envers
    'Réfléchis à la valeur de i après effacement et à la conséquence de NEXT qui suit...
    iFlag = 0
    For j = 2 To DL_Source
        If (WbListe.Worksheets(1).Range("B" & i).Value = WbSource.Worksheets(1).Range("B" & j).Value) Then
            iFlag = 1       'référence rencontrée
            Exit For
        End If
    Next
    'si iFlag = 0 -> référence non rencontrée donc inexistante : effacement
    If iFlag = 0 Then WbListe.Worksheets(1).Rows(i).Delete shift:=xlUp
Next

A+