Vba - multivlookup

[Nunos11]

Hello everybody,

I block with loop.

I try to consolidate table with 3 criteria. In first time I look to find item in accordance with another value. And second time to search in accordance with the first action the value stack in table PROD.

I attach the file, it's more explicit .....

File

Current script:

Option Explicit
Sub TaskperDay()
'--------------------------------------------------------------------------------------------------------------------------
'Variable
'--------------------------------------------------------------------------------------------------------------------------
    Dim cellule As Range 'variable range
    Dim value1 As Range 'variable text
    Dim l As Long, Li As Long, C As Long
    Dim Cel As Range, Cel1 As Range
    Dim derligne As Integer
    Dim i As Byte, x
    'Sheets("Matrice").Range("BJ2:BT" & Sheets("Matrice").Range("BJ65535").End(xlUp).Row).ClearContents 'ajout
'--------------------------------------------------------------------------------------------------------------------------
'MSN link to SCOPE
'--------------------------------------------------------------------------------------------------------------------------
  'Source value
  Set value1 = Sheets("Dashboard").Range("A2")
  'Search the value in extract tab
  For Each cellule In Sheets("Table").Range("Q2:Q" & Sheets("Table").Range("A65535").End(xlUp).Row)
  If cellule = value1 Then
  'Write the resultat
  Sheets("Matrice").Range("BJ" & Sheets("Matrice").Range("BJ65535").End(xlUp).Row + 1) = Sheets("Table").Cells(cellule.Row, 1)
  End If
  Next
'--------------------------------------------------------------------------------------------------------------------------
'Consolidation Hours
'-------------------------------------------------------------------------------------------------------------------------
derligne = Sheets("PROD").Cells(65000, 1).End(xlUp).Row
Li = 2
For i = 1 To derligne Step 11


    If IsDate(Sheets("PROD").Cells(i, 2)) Then
        For Each Cel In Sheets("PROD").Range("A" & i & ":Q" & i)
            If Cel = Sheets("Matrice").Range("BJ1") Then C = Cel.Column: Exit For
        Next
        If C > 0 Then
            For Each Cel1 In Sheets("Matrice").Range("BK1:BT1")
                For Each Cel In Sheets("PROD").Range("A" & i + 1 & ":A" & i + 10)
                    If Left(Cel, Len(Cel1)) = Cel1 Then l = Cel.Row: Exit For
                Next
                Sheets("Matrice").Cells(Li, Cel1.Column) = CDate(Sheets("PROD").Cells(l, C))
                Sheets("Matrice").Cells(Li, Cel1.Column).NumberFormat = "0.0"
            Next
        End If
    End If


Li = Li + 1
If Sheets("Matrice").Range("BJ" & Li) = "" Then Exit For
Next i
'--------------------------------------------------------------------------------------------------------------------------
'Clear memory system
'--------------------------------------------------------------------------------------------------------------------------
  Set Cel = Nothing
  Set Cel1 = Nothing
  Set cellule = Nothing
  Set value1 = Nothing
End Sub

Thank you in advance for your support