Ich habe ein Makro geschrieben, mit dem die Namen von Arbeitsblättern sowohl in einem Index in einer Teamübersicht als auch in einer Arbeitsmappe alphabetisch sortiert werden. Der letzte Schritt besteht darin, leere oder nicht verwendete Blätter mit dem Namen (zzass) auszuschließen und dann den Index mit dem richtigen entsprechenden Blatt zu verknüpfen. Dieses Makro funktioniert, wenn es der Arbeitsmappe wie gewünscht hinzugefügt wird, anstatt dieses Makro zu mehr als 100 Arbeitsmappen hinzuzufügen. Ich habe versucht, ein persönliches Makro zu erstellen. Bis auf den letzten Schritt zum Erstellen der Hyperlinks funktioniert alles. Irgendwelche Ideen?

' feist Macro
    ActiveSheet.Range("$A$6:$AY$56").AutoFilter Field:=1
    ActiveWindow.SmallScroll Down:=3
    Range("A7:A56").Select
    Selection.Hyperlinks.Delete
    ActiveWorkbook.Worksheets(".Team_Overview").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(".Team_Overview").AutoFilter.Sort.SortFields.Add Key _
        :=Range("A6:A56"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets(".Team_Overview").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=3
    Range("A7:A56").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
'ActiveSheet.Protect UserInterfaceOnly:=True
    Range("A6:AY56").Select
    ActiveWorkbook.Worksheets(".Team_Overview").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(".Team_Overview").Sort.SortFields.Add Key:=Range( _
        "A6"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets(".Team_Overview").Sort
        .SetRange Range("A7:AY56")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    ActiveSheet.Range("$A$6:$AY$56").AutoFilter Field:=1, Criteria1:=RGB(0, 0, _
        255), Operator:=xlFilterFontColor
    ActiveSheet.Range("$A$6:$AY$56").AutoFilter Field:=1
    ActiveSheet.Range("$A$6:$AY$56").AutoFilter Field:=1, Criteria1:="<>*zza*" _
        , Operator:=xlAnd

        Dim x As Long, y As Long
For x = 1 To Worksheets.Count
     For y = x To Worksheets.Count
         If UCase(Sheets(y).Name) < UCase(Sheets(x).Name) Then
               Sheets(y).Move before:=Sheets(x)
          End If
     Next
Next

Sheets(".Team_Overview").Select

'ActiveSheet.Protect UserInterfaceOnly:=True
    Range("A6:AY56").Select
    ActiveWorkbook.Worksheets(".Team_Overview").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(".Team_Overview").Sort.SortFields.Add Key:=Range( _
        "A6"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets(".Team_Overview").Sort
        .SetRange Range("A7:AY56")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply

    End With
    ActiveSheet.Range("$A$6:$AY$56").AutoFilter Field:=1, Criteria1:="<>*zza*" _
        , Operator:=xlAnd '
    ActiveSheet.Range("$A$6:$AY$56").AutoFilter Field:=1, Criteria1:=RGB(0, 0, _
        255), Operator:=xlFilterFontColor
    ActiveSheet.Range("$A$6:$AY$56").AutoFilter Field:=1
    ActiveSheet.Range("$A$6:$AY$56").AutoFilter Field:=1, Criteria1:="<>*zza*" _
        , Operator:=xlAnd



Sheets(".Team_Overview").Select

   Dim ws As Worksheet
    Dim i As Integer

    i = 7

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "zzassoc 1" And ws.Name <> "zzassoc 2" And ws.Name <> "zzassoc 3" And ws.Name <> "zzassoc 4" And ws.Name <> "zzassoc 5" And ws.Name <> "zzassoc 6" And ws.Name <> "zzassoc 7" And ws.Name <> "zzassoc 8" And ws.Name <> "zzassoc 9" And ws.Name <> "zzassoc 10" And ws.Name <> "zzassoc 11" And ws.Name <> "zzassoc 12" And ws.Name <> "zzassoc 13" And ws.Name <> "zzassoc 14" And ws.Name <> "zzassoc 15" And ws.Name <> "zzassoc 16" And ws.Name <> "zzassoc 17" And ws.Name <> "zzassoc 18" And ws.Name <> "zzassoc 19" And ws.Name <> "zzassoc 20" And ws.Name <> "zzassoc 21" And ws.Name <> "zzassoc 22" And ws.Name <> "zzassoc 23" And ws.Name <> "zzassoc 24" And ws.Name <> "zzassoc 25" And ws.Name <> "zzassoc 26" And ws.Name <> "zzassoc 27" And ws.Name <> "zzassoc 28" And ws.Name <> "zzassoc 29" Then
        If ws.Name <> "zzassoc 30" And ws.Name <> "zzassoc 31" And ws.Name <> "zzassoc 32" And ws.Name <> "zzassoc 33" And ws.Name <> "zzassoc 34" And ws.Name <> "zzassoc 35" And ws.Name <> "zzassoc 36" And ws.Name <> "zzassoc 37" And ws.Name <> "zzassoc 38" And ws.Name <> "zzassoc 39" Then
        If ws.Name <> "zzassoc 40" And ws.Name <> "zzassoc 41" And ws.Name <> "zzassoc 42" And ws.Name <> "zzassoc 43" And ws.Name <> "zzassoc 44" And ws.Name <> "zzassoc 45" And ws.Name <> "zzassoc 46" And ws.Name <> "zzassoc 47" And ws.Name <> "zzassoc 48" And ws.Name <> "zzassoc 49" And ws.Name <> "zzassoc 50" And ws.Name <> ".Team_Overview" And ws.Name <> "Sheet1" Then

        ActiveWorkbook.Sheets(".Team_Overview").Hyperlinks.Add _
        Anchor:=ActiveWorkbook.Sheets(".Team_Overview").Cells(i, 1), _
        Address:="", _
        SubAddress:="'" & ws.Name & "'!A1", _
        TextToDisplay:=ws.Name

        i = i + 1
        End If
        End If
        End If
    Next ws

'
End Sub
Thomas
quelle