macro pessoal não irá hiperlink dados em uma pasta de trabalho ativa


-1

Eu escrevi uma macro que ordenará os nomes das folhas em um índice em uma visão geral da equipe, bem como classificarei as guias na mesma pasta de trabalho. a etapa final é excluir folhas em branco ou não utilizadas nomeadas (zzass) e, em seguida, vincular o índice à planilha correspondente correta. Essa macro funciona se for adicionada à pasta de trabalho como deve, em vez de adicionar essa macro a 100 pastas de trabalho, tentei criar uma macro pessoal e tudo funciona, exceto a etapa final para criar os hiperlinks. Alguma ideia?

' 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
Ao utilizar nosso site, você reconhece que leu e compreendeu nossa Política de Cookies e nossa Política de Privacidade.
Licensed under cc by-sa 3.0 with attribution required.