AW: Blattregisternamen in Tabelle
19.07.2014 08:20:16
Serge
Hallo Bernd
mit diesem Makro werden alle Registerblätter in einer Liste aufgeführt und zugleich noch einen Hyperlink dazu formatiert:
Sub Name()
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Dim WS As Worksheet
Dim X As Integer
Dim Y As Integer
Set WS = ActiveSheet
For X = 1 To ActiveWorkbook.Worksheets.Count
For Y = X To ActiveWorkbook.Worksheets.Count
If Worksheets(Y).Name < Worksheets(X).Name Then
Worksheets(Y).Move Before:=Worksheets(X)
End If
Next Y
Next X
WS.Activate
Set WS = Nothing
Dim i As Integer
For i = 1 To Worksheets.Count
Cells(i, 1) = Sheets(i).Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 1), Address:="", SubAddress:= _
"'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
Next 'i
Columns("A:A").Select
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
End With
Columns("A:A").EntireColumn.AutoFit
Application.ScreenUpdating = True
Application.GoTo Reference:="R3C1"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Dim WsShell, intText As Integer
Set WsShell = CreateObject("WScript.Shell")
intText = WsShell.Popup("Inhalt neu aufgelistet - - - Hinweis wird automatisch nach 3 _
Sekunden geschlossen!!!", 3, "Huhu ...")
End Sub
mit dem nächste könntest Du die Blätter zuerst alphabetisch sortieren:
Sub BlätterSortieren()
' Register sortieren
Application.ScreenUpdating = False
Dim WS As Worksheet
Dim X As Integer
Dim Y As Integer
Set WS = ActiveSheet
For X = 1 To ActiveWorkbook.Worksheets.Count
For Y = X To ActiveWorkbook.Worksheets.Count
If Worksheets(Y).Name < Worksheets(X).Name Then
Worksheets(Y).Move Before:=Worksheets(X)
End If
Next Y
Next X
WS.Activate
Set WS = Nothing
Application.ScreenUpdating = True
MsgBox "Blätter sortiert!"
End Sub
Gruss Serge