menu på side 1

kør denne makro
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.Holger Bak ©")
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.Holger Bak ©"
  ActiveCell.Font.Color = vbBlue
  ActiveCell.Font.Bold = True
  ActiveCell.Font.Italic = True

    Range("A1:E1").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:f31").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: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").Select
    Selection.Cut
    Range("B2").Select
    ActiveSheet.Paste
    Range("A60:A88").Select
    Selection.Cut
    Range("C2").Select
    ActiveSheet.Paste
    Range("A89:A117").Select
    Selection.Cut
    Range("d2").Select
    ActiveSheet.Paste
    Range("A118:A146").Select
    Selection.Cut
    Range("e2").Select
    ActiveSheet.Paste
    Columns("A:E").Select
    Selection.ColumnWidth = 22
Range("d30").Select
       
Else
Exit Sub
End If
End Sub

Hej Kabbak
Jeg kan ikke bruge sub'en som den ser ud her, men hvis jeg trods din copyright må ændre i den, så tror jeg at jeg selv kan få den fixet så den indeholder det jeg gerne vil have. Er det ok for dig??

ja da, du må ændre lige hvad du vil.;-))

tak for point ;-))

Selv tak - og mange tak for din hjælp!!!