Option Explicit
Option Base 1
Sub Transfert()
Dim c&, i&, j&, DerL&, Plage As Range, Tblo(), Ident(), Id
DerL = [E65536].End(xlUp).Row
Set Plage = Feuil1.[A7].Resize(DerL, 62)
j = 1
With Feuil2
Ident = .Range(.Cells(2, 7), .Cells(.[G65536].End(xlUp).Row, 7))
For Each Id In Ident
If Id <> "" Then
If Not IsError(Application.Match(Id, Plage.Columns(5), 0)) Then
i = Application.Match(Id, Plage.Columns(5), 0)
ReDim Preserve Tblo(1 To 53, 1 To j)
For c = 10 To Plage.Columns.Count
If IsDate(Plage(i, c)) Then Tblo(c - 9, j) = "ü"
Next c
j = j + 1
End If
End If
Next
.[Y2].Resize(UBound(Tblo, 2), UBound(Tblo, 1)) = Application.Transpose(Tblo)
End With
Feuil2.Activate
End Sub