Private Sub Worksheet_Activate()
Dim d As Object, c As Range, dat As Range, n As Byte
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'évite le recalcul des formules
For Each c In Cells.SpecialCells(xlCellTypeFormulas, 1)
If IsDate(c) Then
d(c.Value2) = c.Address 'mémorise l'adresse
c(1, 2).Resize(, 3) = "" 'RAZ
End If
Next c
With Sheets("Saisie des dates")
If Application.Count(.Cells) = 0 Then Exit Sub 'si aucune date
For Each dat In .Cells.SpecialCells(xlCellTypeConstants, 1)
If d.exists(dat.Value2) Then
Set c = Range(d(dat.Value2))
For n = 2 To 4
If c(1, n) = "" Then
If TypeName(dat(1, 2).Value) = "String" Then c(1, n) = dat(1, 2) Else c(1, n) = .Cells(1, dat.Column)
Exit For
End If
Next n
End If
Next dat
End With
Application.Calculation = xlCalculationAutomatic
End Sub