Macro para extraer datos de archivos excel
Necesito una macro para extraer una serie de datos de una carpeta de archivos excel
La carpeta se llama "semana 25" y en ella hay unos 50 archivos distintos "MT2_order_1", "MT2_order_2"... Así hasta unos 50 (a veces más)
De cada archivo, necesito extraer de ellas los datos que están en la hoja "pedido final", de las filas 2 a 30, columnas A hasta la G
Todos los datos tienen que quedar en una hoja final listados unos a continuación de otros
2 respuestas
Utiliza la siguiente macro, pon la macro en un libro nuevo, guarda el libro en la misma carpeta en donde tienes todos los archivos. Ejecuta la macro y en la primer hoja tendrás los datos.
Revisa los resultados y me comentas si hay que cambiarle algo a la macro.
Sub copia_hojas()
'Por.DAM
On Error Resume Next
hoja = "pedido final"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set l1 = ThisWorkbook.Sheets("Hoja1")
Set h1 = l1.Sheets(1)
'
ruta = ThisWorkbook.Path
ChDir ruta
archi = Dir("*.xls*")
Do While archi <> ""
If archi <> h1.Name Then
Workbooks.Open archi
If Err.Number = 0 Then
uf = h1.Range("A1").SpecialCells(xlLastCell).Row + 1
Sheets(hoja).Range("A2:G30").Copy h1.Cells(uf, "A")
Workbooks(archi).Close
End If
Err.Number = 0
End If
archi = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Proceso de copiar hojas, Terminado", vbInformation
End Sub
hola
antes de nada muchas gracias por la ayuda
he probado la macro pero me abre los archivos por la hoja "pedido final" pero no me copia nada
lo que he hecho es crear un nuevo excel en la carpeta "semana 25", doy a alt f11, hago doble click en hoja1 y pego el texto en la parte derecha
cuando ejecuto la macro me abre todos los archivos por la hoja "pedido final" y no hace nada más
igual estoy haciendo algo mal, si puedes echarle un vistazo te lo agradezco
un saludo
Disculpa por el contratiempo.
Utiliza esta macro.
Sub copia_hojas()
'Por.DAM
On Error Resume Next
hoja = "pedido final"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set l1 = ThisWorkbook
Set h1 = l1.Sheets(1)
'
ChDir ThisWorkbook.Path
archi = Dir("*.xls*")
'
Do While archi <> "" And archi <> l1.Name
Workbooks.Open archi
uf = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 1
Sheets(hoja).Range("A2:G30").Copy h1.Cells(uf, "A")
Workbooks(archi).Close
archi = Dir()
Loop
'
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Proceso de copiar hojas, Terminado", vbInformation
End SubIgualmente revisa el resultado, si tienes algún problema avísame para revisarlo.
Saludos. Dante Amor
muchas gracias
he probado y ya saca un listado en una hoja excel
sin embargo no coge las 30 filas de cada una de los archivos, sino que coge todo del mismo archivo, el primero
a ver si puedes echarme una mano
un saludo
Cambia en la macro esta línea
uf = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 1
Por esta
uf = h1. Range("A1"). SpecialCells(xlLastCell). Row + 1Revisa el resultado en toda la hoja, ya que con esta instrucción también te respetará las filas que tienes en blanco, es decir, si tienes 29 líneas en blanco, en al copia te pondrá 29 líneas en blanco.
También revisa que tus archivos tengan la hoja "pedido final", si no tienes una hoja con ese nombre en los archivos no te va a copiar nada.
hola
he hecho el cambio y hace la función correctamente para las columnas A y B. A partir de la C es cuando falla
he chequeado que los archivos de origen estén correctos y está todo ok
la verdad que no sé por qué puede ser este error
un saludo y muchas gracias!
Envíame el archivo1 con la macro y envíame un par de tus archivos que quieres concentrar.
En otra hoja del archivo1, muéstrame cómo debe quedar la información de ese par de archivos.
Alt to (y Dante)
a) Coloca la siguiente macro en un módulo común de cualquier libro:
Sub copia_hojas()
'------------------
'by Cacho Rodríguez
'------------------
Dim ws As Worksheet, iFile$, iRow&, mFolder$
Set ws = ActiveSheet
ws.Range(ws.[a1], ws.[a1].SpecialCells(11)).Offset(1).Delete xlShiftUp
mFolder = ThisWorkbook.Path & "\Semana 25"
iFile = Dir(mFolder & "\MT2_order_*.xls*")
iRow = 2
Do Until iFile = ""
With ws.Cells(iRow, "a").Resize(29, 7)
.Formula = "=if('" & mFolder & "\[" & iFile & "]Pedido final'!a2="""", """", '" & mFolder & "\[" & iFile & "]Pedido final'!a2)"
.Value = .Value
End With
iFile = Dir
iRow = iRow + 29
Loop
End Subb) La carpeta en la que guardes el libro que contenga esta macro, deberá incluir a la sub-carpeta Semana 25.
c) La técnica que aporta esta macro aplica a la copia de datos ubicados en una hoja fija (Pedido final) y en un rango fijo (a2:g30).
¿En qué consiste?... Pues en que no requiere abrir -en ningún momento- los libros que se procesan...
hola, excelente, se puede hacer que aparte busque en subcarpetas? porque tengo varios archivos iguales pero en varias carpetas y subcarpetas. abrazo - Nicolas Koroll
Con mucho gusto te ayudo con todas tus peticiones.Crea una nueva pregunta en todoexpertos, en el tema de microsoft excel, en el desarrollo de la pregunta escribe: "para Dante Amor", ahí me describes con detalle lo que necesitas.Sal u dos - Dante Amor