Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Not Intersect(Target, Range("F3")) Is Nothing And Len(Target) >= 8 Then
For Each ws In Worksheets
If Not IsError(ws.[C6]) Then
If Right(ws.[C6], 8) = Right(Target, 8) Then ws.Select
End If
Next
End If
If Target.Column = 1 And Target <> "" Then
Sheets("999").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Target
Sheets(Sheets.Count).Unprotect "bascas"
Sheets(Sheets.Count).Range("C3").Value = ActiveSheet.Name
Sheets("Main").Range(Target.Address).Offset(0, 7) = "=" & Target & "!$D$46"
Sheets("Main").Range(Target.Address).Offset(0, 8) = "=" & Target & "!$I$46"
Sheets("Main").Range(Target.Address).Offset(0, 9) = "=" & Target & "!$N$46"
Sheets("Main").Range(Target.Address).Offset(0, 10) = "=" & Target & "!$S$46"
Sheets("Main").Range(Target.Address).Offset(0, 11) = "=" & Target & "!$T$46"
Sheets("Main").Range("D" & Target.Row).Formula = "=HYPERLINK(""" & Target & "!A1" & """,""" & Target & """)"
ElseIf Not Intersect(Target, Range("F3")) Is Nothing And Target <> "" Then
Set knr = Range("E8:E" & Rows.Count).Find(Target, , xlValues, xlWhole)
If Not knr Is Nothing Then Worksheets(knr.Offset(0, -1).Text).Activate
ElseIf Not Intersect(Target, Range("F4")) Is Nothing And Target <> "" Then
Application.Goto Sheets(CStr(Target.Value)).Range("A1")
ElseIf Not Intersect(Target, Range("F5")) Is Nothing And Target <> "" Then
Set knr = Range("B9:B" & Rows.Count).Find(Target, , xlValues, xlWhole)
If Not knr Is Nothing Then Worksheets(knr.Offset(0, -1).Text).Activate
End If
End If
Sheets(Sheets.Count).Protect "bascas"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c
For Each c In Sheets("Main").Range("D8
250")
If c > 0 Then
c.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:="'" & c.Value & "'!A1", TextToDisplay:=" " & c.Value
End If
Next
End Sub