Sommaire avancé [résolu]

[Laosurlamontagne]

Bonjour à tous,

Je cherche à créer sur un onglet excel un sommaire un peu particulier...

J'ai trouvé ce code bien pratique pour faire un sommaire des différents onglets que constituent mon fichier excel:

Sub listOnglet()
Dim I As Integer
ActiveWorkbook.Worksheets("Table of Contents").Select
ActiveSheet.Range("A2").CurrentRegion.ClearContents
For I = 6 To ActiveWorkbook.Worksheets.Count - 1
ActiveSheet.Range("A" & I).Select
ActiveSheet.Hyperlinks.Add _
Anchor:=Selection, _
Address:="", _
SubAddress:="'" & Worksheets(I).Name & "'!A1", _
TextToDisplay:=Worksheets(I).Name
Next
Cancel = True
End Sub

Dans chaque onglet, il y des cellule non vide de la colonne "B" (pas forcement les une en dessous des autres) que je voudrais faire apparaitre dans mon sommaire comme "sous-chapitre" de l'onglet X.

du style:
Colonne A1: Onglet 1
Colonne B1: titre 1.1
Colonne B2: titre 1.2
Colonne A3: Onglet 2
Colonne B3: titre 2.1
Colonne B4: titre 2.2
Colonne B5: titre 2.3
etc...

Auriez-vous une idée pour m'aider ?

Merci !

 

[natorp]

Re : Sommaire avancé

Bjr,

un petit bout de fichier exemple serait le bienvenu

cordialement, Gérard

 

[Laosurlamontagne]

Re : Sommaire avancé

Ce serait plus clair, en effet...

 

[david84]

Re : Sommaire avancé

Bonjour,
à tester :

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

A+

 

[Laosurlamontagne]

Re : Sommaire avancé

Bonjour !

ça marche super bien !!! Un très grand merci !