Recherche avec critères croisés

=INDEX('Nbr de séjours'!$B$1:$B$8;SOMMEPROD(('Nbr de séjours'!$A$2:$A$8='liste des actes'!A2)*('Nbr de séjours'!$C$2:$C$8<'liste des actes'!B2)*('Nbr de séjours'!$D$2:$D$8>'liste des actes'!B2)*LIGNE('Nbr de séjours'!$A$2:$A$8)))

Sub Macro2()
Dim l As Object 'déclare la variable l (onglet Liste des actes)
Dim n As Object 'déclare la variable n (onglet Nbr de séjours)
Dim dll As Integer 'déclare la variable dll (Dernière Ligne Liste des actes)
Dim dln As Integer 'déclare la variable dln (Dernière Ligne Nbr de séjours)
Dim pll As Range 'déclare la variable pll (PLage Liste des actes)
Dim pln As Range 'déclare la variable pln (PLage Nbr de séjours)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)

Set l = Sheets("liste des actes") 'définit l'onglet l
Set n = Sheets("Nbr de séjours") 'définit l'onglet n
dll = l.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 1 (=A) de l'onglet l
Set pll = l.Range("A2:A" & dll) 'définit la plage pll
dln = n.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 1 (=A) de l'onglet n
Set pln = n.Range("A2:A" & dln) 'définit la plage pln
For Each cel In pll 'boucle sur toutes les cellules cel de la plage pll
    Set r = pln.Find(cel.Value, , xlValues, xlWhole) 'définit la recherche r (recherche dans la plage pln la valeur entière de cel)
    If Not r Is Nothing Then 'condition 1 : si il existe au moins une occurrence trouvée
        pa = r.Address 'définit l'adresse de la première occurrence trouvée
        Do 'exécute
            'condition 2 : si la date est comprise entre les dates de l'occurrence trouvé
            If cel.Offset(0, 1).Value >= r.Offset(0, 2).Value And cel.Offset(0, 1).Value <= r.Offset(0, 3).Value Then
                cel.Offset(0, 3).Value = r.Offset(0, 1).Value 'récupère le numéro de séjour
            End If 'fin de la condition 2
            Set r = pln.FindNext(r) 'redéfinit la recherche r(occurrence suivante)
        Loop While Not r Is Nothing And r.Address <> pa 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en pa
    End If 'fin de la condition 1
Next cel 'prochaine cellule de la boucle
End Sub