Sub Get_index_Morpho()
Dim tr As Integer
Dim i As Long, J As Long, DerL As Long
Dim Bwsh As Worksheet
Application.ScreenUpdating = False
Set Bwsh = Worksheets("A livré")
For J = 2 To Bwsh.Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("BDD")
DerL = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:E" & DerL).Name = "Base"
'critères
.Range("J2") = Bwsh.Range("A" & J) 'produit
.Range("K2") = Bwsh.Range("D" & J) ' traitement
End With
Range("BDD!J10") = ""
Range("BDD!K10") = ""
Range("Base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[BDD!J1:K2], CopyToRange:=[BDD!J9:K9]
If Range("BDD!J10") <> "" Then
Bwsh.Range("E" & J) = Range("BDD!J10")
Bwsh.Range("F" & J) = Range("BDD!K10")
Else
tr = Range("BDD!K2")
For i = 1 To tr
Range("BDD!K2") = tr - i
Range("Base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=[BDD!J1:K2], CopyToRange:=[BDD!J9:K9]
If Range("BDD!J10") <> "" Then
Bwsh.Range("E" & J) = Range("BDD!J10")
Bwsh.Range("F" & J) = Range("BDD!K10")
Exit For
End If
Next i
If Range("BDD!J10") = "" Then Bwsh.Range("E" & J) = "Produit jamais livré"
End If
Next J
Application.ScreenUpdating = True
End Sub