Private Sub Worksheet_Activate()
Dim t, ub&, d As Object, i&, a, b, dercol%, resu(), titres
Dim prem&, empl$, j%, cour$, dat&, k&
'---tableau source--
With Feuil1 'CodeName de la feuille
.[A:F].Sort .[A1], Header:=xlYes, DataOption1:=xlSortTextAsNumbers 'tri
t = .Range("A2:F" & .Cells(.Rows.Count, 1).End(xlUp).Row)
ub = UBound(t)
End With
'---définition du tableau résultat---
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To ub
If Not d.exists(CStr(t(i, 1))) Then d(CStr(t(i, 1))) = i 'valeur texte
Next
a = d.keys: b = d.items
dercol = Cells(1, Columns.Count).End(xlToLeft).Column
ReDim resu(1 To d.Count, 1 To dercol)
titres = [A1].Resize(, dercol)
'---remplissage du tableau résultat---
For i = 1 To d.Count
prem = b(i - 1)
resu(i, 1) = a(i - 1): resu(i, 2) = t(prem, 2)
empl = resu(i, 1)
For j = 3 To dercol
cour = titres(1, j)
dat = 0
For k = prem To ub 'détermination de la date la plus récente
If CStr(t(k, 1)) <> empl Then Exit For
If t(k, 4) = cour Then If t(k, 6) > dat Then dat = t(k, 6)
Next
If dat Then resu(i, j) = dat
Next
Next
'---restitution---
[A2].Resize(d.Count, dercol) = resu
Rows(d.Count + 2 & ":" & Rows.Count).ClearContents
Range(Columns(dercol + 1), Columns(Columns.Count)).ClearContents
End Sub