Como importar de varios Excel valores de unos campos a un Excel maestro?
Tengo muchos excels que son siempre con la misma estructura en una carpeta, tengo que importar de cada uno de los excel's unos datos. Los datos a recoger de todos los excels, siempre estan ubicados en las mismas celdas. Tengo que recoger los datos de H10, E18, E19 y posiblemente más adelante otras casillas.
Quiero crear un archivo maestro que los valores H10 esten en A1 del maestro, E18 en B1 y E19 en C1, así sucesivamente tantos campos como necesite. Y a medida que vaya copiando los valores de los excel's incremente las líneas. Otro Excel copiado: A2, B2, C3...
No sé si me he explicado bien.
1 respuesta
Te anexo una macro.
Cambia en la macro estos valores por los tuyos:
Set h1 = l1.Sheets("Hoja4") 'nombre hoja donde poner los resultados
ruta = "C:\trabajo\archivos\" 'carpeta de archivos
celdas = Array("H10", "E18", "E19") 'celdas a importarSub Importar_Valores()
' Por Dante Amor
'
' Importar de varios Excel valores de unos campos a un Excel maestro
'
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Hoja4") 'nombre hoja donde poner los resultados
ruta = "C:\trabajo\archivos\" 'carpeta de archivos
celdas = Array("H10", "E18", "E19") 'celdas a importar
'
h1.Cells.ClearContents
fila = 1
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
arch = Dir(ruta & "*.xls*")
Do While arch <> ""
Set l2 = Workbooks.Open(ruta & arch)
Set h2 = l2.Sheets(1)
For j = LBound(celdas) To UBound(celdas)
h1.Cells(fila, j + 1).Value = h2.Range(celdas(j)).Value
Next
fila = fila + 1
l2.Close False
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Valores Importados", vbInformation, "IMPORTAR AL ARCHIVO MAESTRO"
End SubSigue las Instrucciones para un botón y ejecutar la macro
- Abre tu libro de Excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- En el menú elige Insertar / Módulo
- En el panel del lado derecho copia la macro
- Ahora para crear un botón, puedes hacer lo siguiente:
- Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
- Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
- Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona: Tamaño y Propiedades. En la ventana que se abre selecciona la pestaña: Propiedades. Desmarca la opción “Imprimir Objeto”. Presiona “Cerrar”
- Vuelve a presionar click derecho dentro de la imagen y ahora selecciona: Asignar macro. Selecciona: Importar_Valores
- Aceptar.
- Para ejecutarla dale click a la imagen.
'.[Sal u dos. Dante Amor. No olvides valorar la respuesta.
¡Gracias!
Es lo que quería exactamente, eres un crack. Me encanta que haya gente como usted y pueda ayudar a esta comunidad. MUCHÍSIMAS GRACIAS POR TODO!
Buenas,
Se podría buscar excels en varias carpetas a la vez? dentro de una general, buscar Excel's en subcarpetas? Si se puede como lo hago? es más complicada la macro?
Gracias.
La siguiente macro, solamente es para poner el nombre de las subcarpetas de una carpeta
Consulta Macro para copiar el contenido de una carpeta
Dim j
Dim rutas As New Collection
Sub carpetasysub()
'por.dam
'lista archivos de una carpeta y todas las subcarpetas y todos sus archivos
'Sheets("Hoja2").Select
pPath = "C:\"
ext = "*"
'On Error Resume Next
Set n = CreateObject("shell.application")
carpeta = n.browseforfolder(0, _
"Selecciona el Directorio Inical", 0, _
pPath).items.Item.Path
If carpeta = "" Then Exit Sub
pPath = carpeta & "\"
uf = Range("C" & Rows.Count).End(xlUp).Row
If uf = 1 Then uf = 2
Range("A2:C" & uf).Clear
j = 2
rutas.Add carpeta
Call agregadir(pPath)
j = 2
For Each sd In rutas
arch = Dir(sd & "\*." & ext)
Range("B" & j) = sd
Do While arch <> ""
Range("C" & j) = arch
arch = Dir
j = j + 1
Loop
Next
Set rutas = Nothing
Columns("A:C").EntireColumn.AutoFit
MsgBox "Fin, poner archivos", vbInformation, "Directorios"
End Sub
Sub agregadir(lpath)
'Agrega directorios
Dim SubDir As New Collection
If Right(lpath, 1) <> "\" Then lpath = lpath & "\"
DirFile = Dir(lpath & "*", vbDirectory)
Do While DirFile <> ""
'Agrega subdirectorios a collection
If DirFile <> "." And DirFile <> ".." Then _
If ((GetAttr(lpath & DirFile) And vbDirectory) = 16) Then _
SubDir.Add lpath & DirFile
DirFile = Dir
Loop
For Each sd In SubDir
Range("A" & j) = sd
j = j + 1
rutas.Add sd
Call agregadir(sd)
Next
End SubA esta macro le tienes que adaptar la macro que importa celdas. Sí es más complicado.
