Sub listOnglet()
Dim I As Integer, J As Integer, k As Byte, Lig As Long, DerLig As Long, T()
Worksheets("Sommaire").Range("A2").CurrentRegion.ClearContents
For I = 2 To ActiveWorkbook.Worksheets.Count
With Worksheets("Sommaire")
Lig = .Range("B" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & Lig).Select
ActiveSheet.Hyperlinks.Add _
Anchor:=Selection, _
Address:="", _
SubAddress:="'" & Worksheets(I).Name & "'!A1", _
TextToDisplay:=Worksheets(I).Name
End With
With Sheets(Worksheets(I).Name)
DerLig = .Range("B" & .Rows.Count).End(xlUp).Row
ReDim T(Application.WorksheetFunction.CountA(.Range("B1:B" & DerLig)))
For J = 1 To DerLig
If .Range("B" & J) <> "" Then T(k) = .Range("B" & J): k = k + 1
Next J
End With
k = 0
Worksheets("Sommaire").Range("A" & Lig).Offset(0, 1).Resize(UBound(T) + 1) = Application.Transpose(T)
Erase T
Next I
End Sub