CREAR INDICE DE HOJAS CON EL DATO QUE HAY EN LA CELDA C4 (DE CADA HOJA)

Sub Listado_Hojas()



'19-abr-11
Dim dato As Long
Dim rangoA1 As Range
Dim NuevoNombre, Resp
'Se validan archivos abiertos.
'
On Error GoTo Errores
Application.StatusBar = "Creando índice ..."
Application.ScreenUpdating = False
ActiveWorkbook.Sheets.Add Before:=Sheets(1)
Set rangoA1 = Sheets(1).Range("a1")
Sheets(1).Range("a1").Value = "ÍNDICE"
dato = ActiveWorkbook.Sheets.Count
Application.Calculation = xlCalculationManual
For i = 1 To dato
    With Sheets(1)
        .Hyperlinks.Add Anchor:=rangoA1.Offset(i, 0), Address:="", _
        SubAddress:="'" & Sheets(i).Name & "'" & "!A1", _
        TextToDisplay:="+'" & Sheets(i).Name & "'" & "!C4"
       

    End With
Next i
ActiveSheet.Range("A2").EntireRow.Delete
Application.ScreenUpdating = True
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic


Cells.Select
    ActiveWindow.DisplayGridlines = False
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Range("B1").Select
    Columns("B:B").ColumnWidth = 36.29
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With


Resp = MsgBox("Desea asignarle un nombre la hoja de índice creada?", vbYesNoCancel + vbQuestion, AddIn)
If Resp = vbYes Then
Application.Dialogs(xlDialogWorkbookName).Show
Else
Exit Sub
End If
Exit Sub
Errores:
Application.Calculation = xlCalculationAutomatic


MsgBox "Ha ocurrido un error: " & vbNewLine & vbNewLine & Err.Description, vbExclamation, AddIn

End Sub