Sacar el dato de una celda especifico en varios excel de una misma carpeta

[Chonzymon]

Hola comunidad...

Soy nuevo en este mundo de las Macros y necesito como dice el titulo sacar el valor de unas celdas de varios archivos excel (*.xslx) dentro de la misma Carpeta (C:\Documents and Settings\Szuniga\Escritorio\Piloto) y la idea es que en cada valor obtenido en las celdas quede hacia la derecha...en total son 10 datos, los cuales están en las celdas (m6,d39,f39,h39,d45,f45,h45,d51,f51h51) y la idea que al ejecutar la macro aparezcan los datos de todos los archivos enlas celdas a1-j1....y del archivo 2...de la a2-j2....y asi sucesivamente...Por fa...que es para la tesis de mi universidad.....alguien que me pueda ayudar o llevarme por el camino correcto que de Macros soy demasiado nulo....

[Chonzymon]

En base a otro usuario he hecho esta Macro, y en verdad no me da error...pero no me arroja ningun dato...

Option Explicit

Sub RecuperaDatoM6_y_D39_y_F39_y_H39_y_D45_y_F45_y_H45_y_D51_y_F51_y_H51_Opcion_1()

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

    Dim ruta_directorio, archivo As String, NombreArchivo As String, NombreHoja

    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", "Hoja1", , , , , 3)


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

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


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

    n = 1

    With Range("A1:J1")

        .Value = Array("Rol", "Si", "No", "Comentario", "Si", "No", "Comentario", "Si", "No", "Comentario")

        .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 & "*.xlsx")


    Do While NombreArchivo <> ""

        n = n + 1

        'Construimos la fórmula para para traer el dato

        'Se extrae el dato, estoy suponiendo que en cada uno de los libros tienes una hoja llamada Hoja1  defuult [en mayúsculas] y ahi estan los datos _

        si no tienes la hoja nombrada de esa forma, por favor cambia el nombre en el inputbox inicial

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

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

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

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

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

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

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

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

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

        Cells(n, "J") = ExecuteExcel4Macro("'" & ruta_directorio & "[" & NombreArchivo & "]" & CStr(NombreHoja) & "'!r2c9") '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 M6,D39,F39,H39,D45,F45,H45,D51,F51,H51"

        .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]