gesorteerde lijst uit tabbladen

[monkey1601]

Hallo Helpers,

Bijgevoegd bestand bestaat uit een aantal sheets.
nu zou ik graag via de macro(lijst_tabblad) automatisch als sheet(totaal) wordt geopend een opsomming willen in kolom 1 van alle aanwezige sheets muv de geopende sheet(totaal) en sheet(basis).
Bij uitvoering nu van de macro komen deze 2 sheets voor in de lijst

 

[Niels28]

plaats dit achter blad totaal

Private Sub Worksheet_Activate()
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "totaal" And sh.Name <> "basis" Then c01 = c01 & "|" & sh.Name
Next
Sheets("totaal").Range("A3").Resize(UBound(Split(c01, "|")), 1).Value = WorksheetFunction.Transpose(Split(Mid(c01, 2), "|"))
End Sub

Niels

 

[monkey1601]

Niels,

Bedankt voor de snelle reactie.
Het werkt prima.
Ter verbetering zou ik deze lijst nog willen sorteren van A-Z en de tekst als hyperlink naar de betreffende sheet

 

[Niels28]

beide achter blad totaal

Private Sub Worksheet_Activate()
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "totaal" And sh.Name <> "basis" Then c01 = c01 & "|" & sh.Name
Next
Sheets("totaal").Range("A3").Resize(UBound(Split(c01, "|")), 1).Value = WorksheetFunction.Transpose(Split(Mid(c01, 2), "|"))
Sheets("totaal").Range("A3: A26").SpecialCells(2).Sort key1:=Range("A3")
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
on error resume next
If Not Intersect(Target, Range("a3:a26")) Is Nothing Then
If Target.Value <> "" Then Sheets(Target.Value).Activate
End If

blad activeren door 2x op de naam te klikken.
vervang de regel beforedoubleclick door het volgende als je dit met 1 klik wilt

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Niels

 

[monkey1601]

Hallo Niels,

de laatste vraag om het project helemaal compleet te maken:

Dezelfde lijst als gegenereerd volgens hierboven weergegeven VBA maar nu op iedere sheet vanaf cel AD1( muv;totaal en basis en natuurlijk op dat moment geopende sheet )

alvast bedankt

 

[Niels28]

Zo iets?

Private Sub Worksheet_Activate()
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "totaal" And sh.Name <> "basis" and And sh.Name <> activesheet.name Then c01 = c01 & "|" & sh.Name
Next
activesheet.Range("AD1").Resize(UBound(Split(c01, "|")), 1).Value = WorksheetFunction.Transpose(Split(Mid(c01, 2), "|"))
activesheet.Range("AD1: AD26").SpecialCells(2).Sort key1:=Range("A3")
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
on error resume next
If Not Intersect(Target, Range("aD1:aD26")) Is Nothing Then
If Target.Value <> "" Then Sheets(Target.Value).Activate
End If

Niels

 

[monkey1601]

Niels,

Als ik laatste code achter de sheet bv fietsen plak krijg ik foutmelding (zie opmerking "fietsen AD2")

 

[Niels28]

sorry hierbij aangepaste versie, er stond 2x and achter elkaar. En bij de onderste macro end sub vergeten mee te kopieren.

Private Sub Worksheet_Activate()
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "totaal" And sh.Name <> "basis" And sh.Name <> ActiveSheet.Name Then c01 = c01 & "|" & sh.Name
Next
ActiveSheet.Range("AD3").Resize(UBound(Split(c01, "|")), 1).Value = WorksheetFunction.Transpose(Split(Mid(c01, 2), "|"))
ActiveSheet.Range("AD3: AD26").SpecialCells(2).Sort key1:=Range("AD3")
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Not Intersect(Target, Range("aD13:aD26")) Is Nothing Then
If Target.Value <> "" Then Sheets(Target.Value).Activate
End If
End Sub

Niels

 

[monkey1601]

Niels,

Als ik beter had gekeken had ik dit zelf ook kunnen zien maar bedankt,
Het werkt nu prima.