Hoppe til et bestemt ark

Hvad tænker du nærmere på?

Hvis du lægger denne kode i modulet "This Workbook", aktiveres arket "forsiden" i celle C9, hvergang projektmappen åbnes. Er det sådan noget, du leder efter?

Private Sub Workbook_Open()
  Sheets("Forsiden").Activate
  Range("c9").Activate
End Sub

Denne her skal i et almindeligt kodemodul og har så fået tildelt genvejstasten CTRL + SHIFT + A, så hver gang man bruger denne tastekombination, aktiveres dette ark.

Sub Makro_gå_til_Forsiden()
' Genvejstast: CTRL + SHIFT + A
    Sheets("Forsiden").Select
End Sub

Nej.....
Hvis man har f.eks. 150 ark, hvordan kommer man så hurtigt fra Ark4 til Ark89 f.eks.
Een eller anden form for genvejstast, hvis det er muligt.
Eller een eller anden slags Gå til.

Jeg lavede denne engang, den laver et ark der hedder Menu, og sætter hyperlink til alle andre ark ind på siden.

Jeg ved ikke om det er det du efterlyser.

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:i1").Select
            With Selection
                .HorizontalAlignment = xlCenter
            End With
            Selection.Merge
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = 3
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = 3
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = 3
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
                .ColorIndex = 3
            End With
        End If
        Range("a2:i31").Select            ' sletter alle data i området til hyperlink
        Selection.ClearContents            '    der kan jo være fjernet sider ???
        Range("a2").Select
        '-----------------------------------------Der laves hyperlink til alle ark  -------------
        For Each ws In Worksheets
            Worksheets("Menu").Range("a2:a260").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").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
                      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                      DataOption1:=xlSortNormal

        '--------------- Flytter data over i kolonner ------------------------
        R = 2
        For I = 31 To 252 Step 28
            Range("A" & I & ":A" & I + 28).Cut
            Cells(2, R).Select
            ActiveSheet.Paste
            R = R + 1
        Next
        Columns("A:I").Select
        Selection.EntireColumn.AutoFit
        Range("A1").Select

    Else
        Exit Sub
    End If
End Sub

Spændende stykke kode kabbak ;-)

mv

Casmic

Må jeg bede om et svar, så jeg kan slutte

Hvem skal svare ??
hvilken kode brugte du ??

ok