Macro pour transposition

Option Explicit

Private Sub Worksheet_Activate()
Dim Te(), Ts(), Le&, Ls&, C, D As New Dictionary, H As Date
Te = Feuil2.[A1].Resize(, Feuil2.[IV1].End(xlToLeft).Column).Value
For C = 2 To UBound(Te, 2): D(Te(1, C)) = C: Next C
ReDim Ts(1 To 1000, 1 To UBound(Te, 2))
Te = Feuil1.[A2:C2].Resize(Feuil1.[A60000].End(xlUp).Row - 1).Value
For Le = 1 To UBound(Te)
   If Te(Le, 2) <> H Then H = Te(Le, 2): Ls = Ls + 1: Ts(Ls, 1) = H
   If D.Exists(Te(Le, 1)) Then Ts(Ls, D(Te(Le, 1))) = Val(Te(Le, 3))
   Next Le
Feuil2.Rows("2:1000").Delete
Feuil2.Columns(1).NumberFormat = "m/d/yyyy h:mm"
Feuil2.[A2].Resize(Ls, UBound(Ts, 2)).Value2 = Ts
End Sub

'Te = Feuil2.[A1].Resize(, Feuil2.[IV1].End(xlToLeft).Column).Value
Te = Feuil2.[A1:AJ1].Value

Private Sub Worksheet_Activate()
Dim Te(), Ts(), Tk(), Le&, Ls&, C, D As New Dictionary, H As Date
Te = Feuil1.[A2:C2].Resize(Feuil1.[A60000].End(xlUp).Row - 1).Value
C = 1
For Le = 1 To UBound(Te)
   If Not D.Exists(Te(Le, 1)) Then C = C + 1: D(Te(Le, 1)) = C
   Next Le
ReDim Ts(1 To 1000, 1 To D.Count + 1)
Tk = D.Keys
For C = 2 To UBound(Ts, 2): Ts(1, C) = Tk(C - 2): Next C
Ls = 1
For Le = 1 To UBound(Te)
   If Te(Le, 2) <> H Then H = Te(Le, 2): Ls = Ls + 1: Ts(Ls, 1) = H
   If D.Exists(Te(Le, 1)) Then Ts(Ls, D(Te(Le, 1))) = Val(Te(Le, 3))
   Next Le
Feuil2.Rows("1:1000").Delete
Feuil2.Columns(1).NumberFormat = "m/d/yyyy h:mm"
Feuil2.[A1].Resize(Ls, UBound(Ts, 2)).Value2 = Ts
End Sub