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