Extraer de libros cerrados celdas elegidas a nuevo libro

[wbt]

Hola

Tengo que sacar de unos 500 libros cerrados algunos valores de celdas. Encontre un código que se adapta casi al 100%.

Mis libros en su (hoja1) sus nombres son diferentes y quisiera encontrar el código adecuado para que lea cada libro cerrado sin importar como se llame la hoja1. Magnifico y práctico código. La parte del código motivo de mi mensaje es: CStr(NombreHoja).

Sub RecuperaDatoA2_y_I2_Opcion_1()

    'Usando función de Macro de Excel4 (predecesor de VBA) [Macrofucion]

    Dim ruta_directorio, Archivo As Application, NombreArchivo As String, NombreHoja As String

    Dim n As Long

    'Indicas la Ruta base, estoy suponiendo que los 4000 archivos estan en el mismo directorio

    ruta_directorio = ObtieneRutaCarpeta '[Uso la función auxiliar para que la puedas elegir]

    If TypeName(ruta_directorio) = "Boolean" Then Exit Sub 'Si se presiona cancelar sale del proceso

    'Inputbox para indicar nombre de hoja

    NombreHoja = Application.InputBox("¿Cómo se llama la hoja dónde estan los datos?" & vbNewLine & vbNewLine & _

                                    "Toma en cuenta que debe estar escrito exatamente igual, es decir considerando mayúsculas y minusculas", _

                                    "Indica Nombre de la Hoja que tiene los datos en cada libro", "ANIMADOR", , , , , 2)


    If TypeName(NombreHoja) = "Boolean" Then Exit Sub

    If VBA.Right(ruta_directorio, 1) <> Application.PathSeparator Then ruta_directorio = ruta_directorio & Application.PathSeparator


    Columns("A:B").Clear 'Borra el contenido anterior

    n = 1

    With Range("A1:B1")

        .Value = Array("Nombre de archivo", "Nombre de UDS")

        .Interior.Color = vbGreen

    End With

    'Se inicia el recorrido y se cargan los datos en la hoja

    'para archivos excel 97-2007

    NombreArchivo = Dir(ruta_directorio & "*.xls")


    Do While NombreArchivo <> ""

        n = n + 1


        Cells(n, "A") = ExecuteExcel4Macro("'" & ruta_directorio & "[" & NombreArchivo & "]" & CStr(NombreHoja) & "'!r18c7") 'estilo r1c1 es decir row1 col1 [Nombre de archivo]

        Cells(n, "B") = ExecuteExcel4Macro("'" & ruta_directorio & "[" & NombreArchivo & "]" & CStr(NombreHoja) & "'!r37c13") 'estilo r1c1 es decir row1 col1 [Nombre de UDS]


        NombreArchivo = Dir    ' Obtiene siguiente entrada.

        Application.StatusBar = " Recorriendo archivos, hasta el momento se han recorrido " & n - 1 & " archivo(s)"

    Loop


    MsgBox "Se extrajeron los datos de " & n - 1 & " archivo(s)", vbInformation

    Application.StatusBar = False

End Sub

Function ObtieneRutaCarpeta()

    Dim FiD As FileDialog, ItemSelect As Variant


    'dialogo para seleccionar una carpeta

    Set FiD = Application.FileDialog(msoFileDialogFolderPicker)

    With FiD

        .Title = "Selecciona la Carpeta que deseas Recorrer para extraer el dato de la celdas A2 y I2"

        .ButtonName = "Seleccionar"

        .AllowMultiSelect = False

        If .Show = -1 Then



            For Each ItemSelect In .SelectedItems

                'se determina el item seleccionado [Ruta Carpeta]

                ObtieneRutaCarpeta = ItemSelect

            Next ItemSelect

        Else

            ObtieneRutaCarpeta = False

        End If

    End With


    Set FiD = Nothing


End Function[/CODE]