Option Explicit
Private Sub Worksheet_Activate()
Dim RDon As Range, TDon(), L&, TRés(), LR&, CR&, N&, Expr$
Set RDon = Feuil3.ListObjects(1).DataBodyRange
TDon = RDon.Value
TRés = Me.[C5:N19].Value
For LR = 3 To 15 Step 3: For CR = 1 To 12: TRés(LR, CR) = Empty: Next CR, LR
For L = 1 To UBound(TDon, 1)
If Date >= TDon(L, 11) And Date < TDon(L, 12) Then
CR = TDon(L, 4): LR = 18 - (CR \ 100) * 3: CR = (CR Mod 100) * 2
N = TRés(LR, CR - 1) + 1
TRés(LR, CR - 1) = N
If N > 1 Then
TRés(LR, CR) = TRés(LR, CR) & "&""" & vbLf & """&" & RDon(L, 5).Address(External:=True) ' TDon(L, 5)
Else: TRés(LR, CR) = "=" & RDon(L, 5).Address(External:=True) 'TDon(L, 5)
End If: End If: Next L
Me.[C5:N19].Value = TRés
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim TJn() As String, N&, Cel As Range
If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then Exit Sub
If Not Target.HasFormula Then Exit Sub
TJn = Split(Mid$(Target.Formula, 2), "&""" & vbLf & """&")
For N = 0 To UBound(TJn)
Set Cel = Evaluate(TJn(N))
TJn(N) = Cel.Value & " " & Cel(1, 2).Value & ", " & Format(Cel(1, 7).Value, "dd/mm/yyyy") & " - " & Format(Cel(1, 8).Value, "dd/mm/yyyy")
Next N
MsgBox Join(TJn, vbLf), vbInformation, Me.Name
End Sub