wie kann ich alle Tabellenblattnamen einer Arbeitsmappe als Liste in einem Arbeitsblatt der selben Mappe ausgeben.
Also in Sheet1 sollte von A1 bis An dann stehen Sheet1, Sheet2, Sheet3 usw.
Wer kann mir helfen.
Gruß
Michael
Sub inhaltsverzeichnis_erstellen()
'Inhaltsverzeichnis aller Tabellenblätter
'im erten Tabellenblatt ab Zeile A1 einfügen
Dim Blatt As Object
Dim zeile As Double
Dim NewSheet As Worksheet
Dim i As Integer
zeile = 3
'Fehlerhandling
On Error Resume Next
'Abfrage unterdrücken
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Sheet Inhaltsverzeichnis auf jeden Fall löschen
Sheets("Inhaltsverzeichnis").Delete
'Neues Tabellenblatt mit dem Namen Inhaltsverzeichnis hinzufügen
Set NewSheet = Worksheets.Add
NewSheet.Name = "Inhaltsverzeichnis"
Sheets("Inhaltsverzeichnis").Move before:=Sheets(1) ' = Tabellenblatt als erstes
'Überschrift Einfügen und formatieren
With Sheets("Inhaltsverzeichnis").Range("A1")
.Value = "Inhaltsverzeichnis"
.Font.Name = "Arial"
.Font.Size = "18"
.Font.Bold = True
.Font.ColorIndex = 6
.Interior.ColorIndex = 5
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Font.Underline = xlUnderlineStyleSingle
End With
With Cells(1, 2)
.Font.Name = "Arial"
.Font.Size = "18"
.Font.Bold = True
.Font.ColorIndex = 6
.Interior.ColorIndex = 5
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
End With
With Cells(1, 3)
.Font.Name = "Arial"
.Font.Size = "18"
.Font.Bold = True
.Font.ColorIndex = 6
.Interior.ColorIndex = 5
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
End With
With Cells(2, 1)
.Value = "sortiert nach Blatt-Nr."
.Font.Name = "Arial"
.Font.Size = "16"
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With
With Cells(2, 5)
.Value = "alphabetisch sortiert"
.Font.Name = "Arial"
.Font.Size = "16"
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With
'Laufende Blattnummerierung + Blattname einfügen
For Each Blatt In Sheets
Sheets("Inhaltsverzeichnis").Cells(zeile, 1).Value = "Blatt " & zeile - 2
Sheets("Inhaltsverzeichnis").Cells(zeile, 2).Value = Blatt.Name
Sheets("Inhaltsverzeichnis").Hyperlinks.Add Anchor:=Cells(zeile, 2), Address:="", SubAddress:="'" & _
Blatt.Name & "'!A1", TextToDisplay:=Blatt.Name
zeile = zeile + 1
Next Blatt
ActiveSheet.Columns("B:B").EntireColumn.AutoFit
'Kopiere die zwei erstellten Spalten und sortiere Hyperlinks
Range("A3", Range("B65536").End(xlUp)).Select
Selection.Copy
Range("D3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("D3", Range("E65536").End(xlUp)).Select
Selection.Sort Key1:=Range("E3"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ActiveSheet.Columns("D:E").EntireColumn.AutoFit
ActiveWindow.DisplayGridlines = False
Range("A3").Select
ActiveWindow.FreezePanes = True
Cells(1, 4).Value = "Diese Datei hat " & Worksheets.Count & " Tabellen"
'Userform ausblenden
'frmInhaltsverz.Hide
'Ursprungszustand wieder herstellen
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub list_sheetnames()
Dim i As Long, j As Long
Dim x As String
Dim all As Long
Dim shArray()
all = ThisWorkbook.Worksheets.Count
ReDim shArray(1 To all)
On Error Resume Next
For i = 1 To all
x = ThisWorkbook.Sheets(i).Name
shArray(i) = x
Next i
For j = LBound(shArray) To UBound(shArray)
Sheets(1).Cells(j + 1, 1) = shArray(j)
Next j
End Sub