Private Sub Worksheet_Activate()
Dim derlig&, t, rest(), i&, x
derlig = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
If derlig > 2 Then
t = Feuil1.Range("A3:A" & derlig + 1) 'au moins 2 items
ReDim rest(1 To derlig, 1 To 1) 'base 1
On Error Resume Next
For i = 1 To derlig
x = t(i, 1)
rest(i, 1) = CDate(Join(Array(Left(x, 4), Mid(x, 5, 2), Right(x, 2)), "/"))
Next
Range("A3:A" & derlig) = rest
End If
Range("A" & derlig + 1 & ":A" & Rows.Count).Delete xlUp
End Sub