Sub Tableau()
Dim dat As Variant, d As Object, cel As Range, lig&, adr1$, adr2$
Feuil2.Activate 'CodeName de la feuille 'Rapprochement'
Rows("2:" & Rows.Count).ClearContents
dat = [F1] '= InputBox("Date (facultative) de début de compte :", "Date")
If IsDate(dat) Then dat = CDate(dat) Else dat = "aucune"
[F1] = dat
Set d = CreateObject("Scripting.Dictionary")
On Error Resume Next 's'il n'y a pas de valeurs
With Feuil1 'CodeName de la feuille 'Export'
For Each cel In .Range("AV2:AV" & Rows.Count).SpecialCells(xlCellTypeConstants)
If Not d.Exists(cel.Value) Then d.Add cel.Value, cel.Offset(, 1)
lig = cel.Row
Next
adr1 = "'" & .Name & "'!" & .Columns("AV").Resize(lig).Address(ReferenceStyle:=xlR1C1)
adr2 = "'" & .Name & "'!" & .Columns("BC").Resize(lig).Address(ReferenceStyle:=xlR1C1)
End With
[A2].Resize(d.Count) = Application.Transpose(d.Items)
[B2].Resize(d.Count) = Application.Transpose(d.Keys)
If dat = "aucune" Then
[C2].Resize(d.Count).FormulaR1C1 = "=COUNTIF(" & adr1 & ",RC2)"
Else
[C2].Resize(d.Count).FormulaR1C1 = "=SUMPRODUCT((" & adr1 & "=RC2)*(" & adr2 & ">=R1C6))"
End If
[C2].Resize(d.Count) = [C2].Resize(d.Count).Value 'facultatif, supprime les formules
End Sub