Sub aa()
Dim S As Worksheet
Dim R As Range
Dim var
Dim i&
Dim j&
Dim cpt& 'compteur
Dim T()
'---
Set S = Sheets("DP BOISS") 'à adapter
Set R = S.UsedRange
var = R
For j& = 6 To UBound(var, 2)
If var(4, j&) <> "" Then
For i& = 5 To UBound(var, 1)
If var(i&, j&) <> "" Then
cpt& = cpt& + 1
ReDim Preserve T(1 To 3, 1 To cpt&)
T(1, cpt&) = var(i&, 5)
If IsDate(var(4, j&)) Then var(4, j&) = Format(var(4, j&), "dd-mmmm")
T(2, cpt&) = var(4, j&)
T(3, cpt&) = var(i&, j&)
End If
Next i&
End If
Next j&
If cpt& > 0 Then
Set S = Sheets.Add
Set R = S.Range(S.Cells(1, 1), S.Cells(cpt&, 3))
R = Application.WorksheetFunction.Transpose(T)
End If
End Sub