Opret oversigtsark

Denne makro opretter eller opdaterer et ark med en oversigt over alle andre ark i mappen. Der indsættes hyperlink for hvert ark, så listen kan anvendes som klikbar indholdsfortegnelse.

Sub ListArk()
    Dim s As Worksheet
    Dim n As Integer

    On Error GoTo Sheeterr

    Sheets("Liste_over_ark").Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True

Sheeterr:
    n = 2
    With Worksheets.Add
        .Name = "Liste_over_ark"
        .Move Before:=Worksheets(1)
    End With

    For Each s In ActiveWorkbook.Sheets
        If s.Name <> "Liste_over_ark" Then
            Sheets("Liste_over_ark").Range("a" & n) = s.Name
            n = n + 1
        End If
    Next s

    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("a1").Select

    For Each c In Range("a:a").Cells
        If Not IsEmpty(c.Value) Then
            c.Select
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
            c.Value & "!A1", TextToDisplay:=c.Value
        End If
    Next

End Sub

Se også den alternative løsning.

- Retur til makroer -