Finde arknavne i fil

Jeg lavede denne for år siden, måske kan den bruges


Public Sub Menu()
    Dim W As Integer, K As Integer, A As Integer
    A = MsgBox("Vil du indsætte et ark ved navn MENU, eller opdatere eksisterende, hvor der er Hyperlink til dine ark", vbYesNo, "MENU OPRETTER  v.Kabbak  ©")
    If A = 6 Then
        W = 1    ' styrer række inden for hyperlink
        K = 1    ' styrer kolonner inden for hyperlink
        For Each WS In Worksheets
            If WS.Name = "Menu" Then GoTo Findes
        Next WS

        Set NewSheet = Worksheets.Add    ' opretter nyt ark
        NewSheet.Name = "Menu"        ' navngiver det nye ark

Findes:
        Worksheets("Menu").Activate
        Range("a1").Select
        If ActiveCell.Value = "" Then
            ActiveCell.Value = "MENU Styring    v.Kabbak ©"
            ActiveCell.Font.Color = vbBlue
            ActiveCell.Font.Bold = True
            ActiveCell.Font.Italic = True
            Range("A1:E1").HorizontalAlignment = xlCenter
            Range("A1:E1").Merge
           
        End If
        Range("a2:f31").ClearContents        ' sletter alle data i området til hyperlink
        Range("a2").Select
        '-----------------------------------------Der laves hyperlink til alle ark  -------------
        For Each WS In Worksheets
            Worksheets("Menu").Range("a2:a150").Cells(W, K).Select    ' reseverer et område til at skrive hyperlink i

            If WS.Name = "Menu" Then GoTo Næste    ' Hopper over hovedarket "Menu"

            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & WS.Name & "'" & "!A1"
            ActiveCell.FormulaR1C1 = WS.Name    ' skriver hyperlink på alle sider inden for området
            W = W + 1
Næste:
        Next WS
        '------------------------------Soterer kollonne A ----------------------------
        Range("A2:A150").Select
        Selection.Sort Worksheets("Menu").Columns("A"), Order1:=xlAscending, Header:=xlGuess, _
                      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

        '--------------- Flytter data over i 4 kolonner ------------------------
        Range("A31:A59").Cut Range("B2")
        Range("A60:A88").Cut Range("C2")
        Range("A89:A117").Cut Range("D2")
        Range("A118:A146").Cut Range("E2")
        Columns("A:E").ColumnWidth = 22
    Else
        Exit Sub
    End If
End Sub

Et alternativ er at oprette en navngiven formel som føllger:

Navn: wsNames
Formel:=RIGHT(GET.WORKBOOK(1);LEN(GET.WORKBOOK(1))-FIND("]";GET.WORKBOOK(1)))

Herefter kan du indsætte følgende i A1 og kopiere nedad:

=INDEX(wsNames;ROW(1:1))

Hej kabbak, din kode virker efter hensigten, 1000 tak for hjælpen, smider du et svar.

Hej dkhanknu
Jeg kan ikke få din løsnig til at virke, er det fordi formlerne er på engelsk? vil gerne afprøve løsningen. Har du mulighed for at oploade et eksempel? Opretter gerne en ny tråd.

;-)

http://gupl.dk/707569/

Hvis du kigger i Navnestyring vil du se noget der er kaldt shName. Den er overflødig i den her forbindelse. Det er kun wsNames der er relevant.

Hans

Hej Hans, fantastisk og 1000 tak, jeg opretter en tråd til point

Glem det bare.
Jeg samler ikke.

Hans