Recherche avec deux conditions et deux boucles?

Sub test()
Dim DerLig As Long, DerCol As Long, Lig As Long, Col As Long
Dim Valeur As Range, Mois As Range, Code As Range
Dim ShDélai As Worksheet, ShCIC As Worksheet
Set ShDélai = Sheets("Délai - Tableau 1")
Set ShCIC = Sheets("CIC - Tableau 1")
DerLig = ShDélai.[A65536].End(xlUp).Row
DerCol = ShDélai.[IV1].End(xlToLeft).Column
For Each Valeur In ShDélai.Range("B2", ShDélai.Cells(DerLig, DerCol)).SpecialCells(xlCellTypeConstants)
  With ShCIC.Cells
      Set Mois = .Find(ShDélai.Cells(1, Valeur.Column), LookIn:=xlValues, lookat:=xlWhole)
      If Not Mois Is Nothing Then [COLOR=Blue][B]Col [/B][/COLOR]= Mois.Column
      Set Code = .Find(ShDélai.Cells(Valeur.Row, 1), LookIn:=xlValues, lookat:=xlWhole)
      If Not Code Is Nothing Then [COLOR=Blue][B]Lig [/B][/COLOR]= Code.Row
      If Lig > 0 And Col > 0 Then
        .Cells(Lig, Col).Value = Valeur.Value
        Lig = 0: Col = 0
      End If
  End With
Next
End Sub