Combo box - Indsæt data!

Ikke nødvendigt!
Du kan højreklikke på pilene i nederste venstre hjørne, så får du en menu med alle arkene og kan vælge det, du ønsker.

Hilsen KOL

I et modul

Global X As String
Public Sub Sidekald()
Sheets(X).Activate
End Sub


i ThisWorkbook modulet, Ark1 er navnet på det ark du har din combo i

Sub Workbook_Open()
For Each ws In Worksheets
Sheets("Ark1").ComboBox1.AddItem ws.Name
Next
End Sub


I arkmodulet på det ark du har din combo

Private Sub ComboBox1_Change()
X = ComboBox1
Call Sidekald
End Sub

Her er en anden version. Den fylder ikke en komboboks men opretter et nyt ark med hyperlinks til alle de øvrige ark i mappen.

Sub ListArkIMappen()
'Jan Kronsell november 2001

'Koden opretter et ark med en liste over alle
'de ark, der findes i mappen
'De pågældende ark angives som hyperlink

    Dim s As Worksheet
    Dim n As Integer

'Her oprettes arket: "Arkliste"
    n = 2
    With Worksheets.Add
        .Name = "Arkliste"
        .Move Before:=Worksheets(1)
    End With

'Så læses mappen igennem for arknavne
'Og de indsættes i A-kolonnen i "Arkliste
For Each s In ActiveWorkbook.Worksheets
    If s.Name <> "Arkliste" Then
    Sheets("Arkliste").Hyperlinks.Add Anchor:=Range("a" & n), Address:="", SubAddress:= _
        s.Name & "!a1", TextToDisplay:=s.Name
    '    Sheets("Arkliste").Range("a" & n) = s.Name
        n = n + 1
    End If
Next

'Så sletter vi lige en overflødig række
'+ navnet på selve det ark, som listen er i
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("b1").Select
   

End Sub

jkrons> Har lige afprøvet din makro - Virker rigtig godt. Men hvis man skal have nogen glæde af den, vil det være dejligt hvis der bliver oprettet et link fra alle ark til hovedsiden også. Det kan selvfølgelig være lidt svært at sige om celle A1 altid er fri til at lave et link på de forskellige ark, men det kan vi jo bare aftale den er :-) Alternativer kan også gå!!

Jeg kigger lige på det :-)

Her er noget:

Sub ListArkIMappen()
'Jan Kronsell november 2001
'Rettet December 2003

'Koden opretter et ark med en liste over alle
'de ark, der findes i mappen
'De pågældende ark angives som hyperlink
'Desuden oprettes i A1 i hvert ark et hyperlink tilbage til
'Indholdsfortegnelsen

    Dim s As Worksheet
    Dim n As Integer

'Her oprettes arket: "Arkliste"
    n = 2
    With Worksheets.Add
        .Name = "Arkliste"
        .Move Before:=Worksheets(1)
    End With



'Så læses mappen igennem for arknavne
'Og de indsættes i A-kolonnen i "Arkliste
For Each s In ActiveWorkbook.Worksheets
    If s.Name <> "Arkliste" Then
    Sheets("Arkliste").Hyperlinks.Add Anchor:=Range("a" & n), Address:="", SubAddress:= _
        s.Name & "!a1", TextToDisplay:=s.Name
    '    Sheets("Arkliste").Range("a" & n) = s.Name
        n = n + 1
    End If
Next

'Så sletter vi lige en overflødig række
'+ navnet på selve det ark, som listen er i
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("b1").Select
   
'Så opdaterer vi de enkelte ark, så der laves hyperlink tilbage
'til indholdsfortegnelsen
   
For Each s In ActiveWorkbook.Worksheets
    If s.Name <> "Arkliste" Then
        s.Activate
        ActiveSheet.Range("a1").Activate
        s.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
            "Arkliste!A1", TextToDisplay:="Arkliste"
    End If
Next s
Sheets("Arkliste").Activate

End Sub

De to ovensående løsninger forudsætter begge, at "Arliste" - altså indholdsfortegnelsen IKKE eksisterer i forvejen, når makroen køres. Her er en modificeret variant, der tillader at arket med indholdsfortegnelsen allerede eksisterer.

Den er baseret på, at Chip Peason's SheetExists funktion placeres i samme modul som koden til opbygning af indholdsfortegenlsen:

Function SheetExists(SName As String, _
    Optional ByVal WB As Workbook) As Boolean
    'Chip Pearson
    On Error Resume Next
    If WB Is Nothing Then Set WB = ThisWorkbook
    SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function

Derefter kommer så min kode:

Sub ListArkIMappen()
'Jan Kronsell november 2001
'Rettet December 2003. Nedenstående rettelser indført
'Tester om ark allerede findes
'Indsætter hyperlink tilbage til indholdsfortegnelse

'Koden opretter et ark med en liste over alle
'de ark, der findes i mappen
'De pågældende ark angives som hyperlink
'Desuden oprettes i A1 i hvert ark et hyperlink tilbage til
'Indholdsfortegnelsen

    Dim s As Worksheet
    Dim n As Integer

'Vi kontrollerer om der allerede findes en indholdsfortegnelse
    If SheetExists("Arkliste") = True Then
'I så fald renses det pågældende ark for indhold
        Sheets("Arkliste").UsedRange.Clear
'Ellers oprettes et nyt ark til indholdsfortegnelsen
    Else
        With Worksheets.Add
            .Name = "Arkliste"
            .Move Before:=Worksheets(1)
        End With
    End If

    n = 2

'Så læses mappen igennem for arknavne
'Og de indsættes i A-kolonnen i "Arkliste
    For Each s In ActiveWorkbook.Worksheets
        If s.Name <> "Arkliste" Then
            Sheets("Arkliste").Hyperlinks.Add Anchor:=Range("a" & n), Address:="", SubAddress:= _
                s.Name & "!a1", TextToDisplay:=s.Name
            n = n + 1
        End If
    Next

'Så sletter vi lige en overflødig række
'+ navnet på selve det ark, som listen er i
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    Range("b1").Select
   
'Så opdaterer vi de enkelte ark, så der laves hyperlink tilbage
'til indholdsfortegnelsen
   
    For Each s In ActiveWorkbook.Worksheets
        If s.Name <> "Arkliste" Then
            s.Activate
            ActiveSheet.Range("a1").Activate
            s.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
                "Arkliste!A1", TextToDisplay:="Arkliste"
        End If
    Next s
    Sheets("Arkliste").Activate

End Sub

jkrons> sejt :-)