Modificar macro tuya...

Te mando la nueva macro con tu petición:

Ahora cuando la ejecutes se abrirá un browse para que selecciones la carpeta de búsqueda.

Sub hacer_informe()
'por luismondelo
On Error Resume Next
Application.ScreenUpdating = False
informe = ActiveWorkbook.Name
Set navegador = CreateObject("shell.application")
carpeta = navegador.browseforfolder(0, "SELECCIONE UNA CARPETA POR FAVOR", 0, ActiveWorkbook.Path).items.Item.Path
ChDir carpeta & "\"
archi = Dir("*.xls*")
Do While archi <> ""
Workbooks.Open archi
otro = ActiveWorkbook.Name
Workbooks(informe).Activate
filalibre = Sheets(1).Range("a65000").End(xlUp).Row + 1
Cells(filalibre, 1).Value = Workbooks(otro). Sheets(1). Range("c5")
Cells(filalibre, 2).Value = Workbooks(otro). Sheets(1). Range("c7")
Cells(filalibre, 3).Value = Workbooks(otro). Sheets(1). Range("c8")
Cells(filalibre, 4).Value = Workbooks(otro). Sheets(1). Range("c9")
Cells(filalibre, 5).Value = Workbooks(otro). Sheets(1). Range("c10")
Cells(filalibre, 6).Value = Workbooks(otro). Sheets(1). Range("c11")
Cells(filalibre, 7).Value = Workbooks(otro). Sheets(1). Range("c12")
Cells(filalibre, 8).Value = Workbooks(otro). Sheets(1). Range("c13")
Cells(filalibre, 9).Value = Workbooks(otro). Sheets(1). Range("j53")
Cells(filalibre, 10).Value = Workbooks(otro). Sheets(1). Range("k53")
Workbooks(otro).Close False
archi = Dir()
Loop
Application.ScreenUpdating = True
End Sub

no olvides finalizar la consulta

hola como estas....

la ventana se abre elijo directorio pero ahi se queda..... no extrae

termina sin extraer...

un saludo juanjo

Perdona pero acabo de revisarlo y está bien.

Se abre una ventana para elegir una carpeta y después de pulsar aceptar abrirá todos los archivos excel de dicha carpeta para traer la información.

hola luis...

te aseguro que con la macho de arriba poniendo los archivos en el directorio salen los datos....

pero con la modificación selectiona el directorio pero no saca los datos...de verdad...uso excel 2007 por si tiene algo que ver...????

Haz esta prueba. Situate en una hoja en blanco en la celda A1 y ejecuta esta macro:

-Aparecerá el browse, elige una carpeta y deberá hacerte una lista de todos lo archivos excel de esa carpeta y los anotará desde la celda en la que estás hacia abajo.

Sub lista_archivos()
'por luismondelo
On Error Resume Next
Application.ScreenUpdating = False
Set navegador = CreateObject("shell.application")
carpeta = navegador.browseforfolder(0, "SELECCIONE UNA CARPETA POR FAVOR", 0, ActiveWorkbook.Path).items.Item.Path
ChDir carpeta & "\"
archi = Dir("*.xls*")
Do While archi <> ""
activecell.value = archi
activecell.offset(1,0).select
archi = Dir()
Loop
Application.ScreenUpdating = True
End Sub

hago algo mal....tampoco va....

libro nuevo blanco...pongo macro...selecciono a1...ejecuto macro ...elijo directorio acepto y no hace nada...

que raro ...que paso me falta....

Pues está claro que haces algo mal ya que esta última macro también me funciona a mi. Asegúrate que haces click en la carpeta seleccionada...

uff ya pensaba en virus y veinte locuras mas.....lo he intentado en tres pcs distintos....y el tema es que solo funciona las dos macros cuando el disco es c..... si intentas buscar en un pendrive por lo que sea no va.....

un misterio, se podría hacer que también valiese para otro disco duro...

muchas gracias y disculpa todas las molestias...

un saludo juanjo