Jump to content

Importar datos de otros libros, incluir la ruta o nombre del archivo que proviene


Recommended Posts

Buenas Noches, encontre un archivo con una macro para un archivo de consolidacion que estoy generando, pero no encuentro la forma de que junto con la informacion, en cada fila, me ponga en la celda de la "E" correspondiente, el nombre del archivo del cual esta obteniendo la informacion.

Espero alguien pueda ayudarme con este tema.

Incluyo archivo zip con el ejemplo.

Saludos

Consolidacion.zip

Link to comment
Share on other sites

A ver si es esto:

Sub Consolidar()

ChDir (ActiveWorkbook.Path)
ruta = ActiveWorkbook.Path
nonfic = ActiveWorkbook.Name
arch = Dir("*.xls")
fil = 1
Do Until arch = ""
If arch = nonfic Then GoTo Salto
Workbooks.Open Filename:=arch, UpdateLinks:=0
Range("A1:D100").Copy
Windows(nonfic).Activate
uf = Range("A65536").End(xlUp).Row + 1
Range("A" & uf).PasteSpecial
Range("E" & uf) = ActiveWorkbook.Name '<==============
Windows(arch).Activate
ActiveWorkbook.Close
Salto:
arch = Dir
Loop

End Sub


[/CODE]

Link to comment
Share on other sites

Gracias Macro Antonio, desafortunadamente el resultado no es el deseado, ya que arroja el nombre del archivo "Consolidacion.xls", y se necesita que arroje el nombre "1. Almacen Jamaica", por ejemplo. Gracias voy a seguir intentando, tambien agradezco la ayuda de los miembros del foro.

Saludos

Link to comment
Share on other sites

Guest Cacho R

Hola! Jicotillo (y Antoni).

Es un "toque menor" lo que hay que hacer al código mostrado por Antoni.

Sin embargo (y por las dudas) te pido dos ampliaciones de concepto:

a) Los archivos de donde se toma la info para copiarla: ¿SIEMPRE tienen la tabla de datos en la primera hoja del libro? (lo pregunto pues el código planteado "supone" que al abrir esos archivos SIEMPRE veremos la hoja con los datos como ACTIVA, pero ello puede no ser así...).

B) Las tablas de datos: ¿SIEMPRE tienen 100 filas de datos? ¿Pueden ser más?

Si respondes a estas dos preguntas quedaría todo aclarado.

Saludos, Cacho R.

Link to comment
Share on other sites

Bueno ,

a) Si, siempre tienen la tabla de datos en la primera hoja.

B) Las tablas, pueden tener mas de dos mil filas. Pero solo seria en el caso de dos almacenes, son mas del 100 almacenes, aunque para este caso solo estoy tomando 3, para ver como va funcionando la macro.

Link to comment
Share on other sites

Guest Cacho R

Considerando estas dos aclaraciones podrías intentar:

Sub Consolidar()
Dim arch$, myCell As Range

Application.ScreenUpdating = False
Intersect([a1].CurrentRegion, [a:d]).Offset(1).Delete xlShiftUp
Set myCell = [a2]
arch = Dir(ThisWorkbook.Path & "\*.xls")

While arch <> ""
If ThisWorkbook.Name <> arch Then
With Workbooks.Open(ThisWorkbook.Path & "\" & arch, 0, True).Sheets(1)
Intersect(.[a1].CurrentRegion, .[a:d]).Copy
myCell.PasteSpecial: Application.CutCopyMode = xlCopy
.Parent.Close False
End With
End If
Set myCell = [a65536].End(xlUp).Offset(1)
arch = Dir
Wend

Application.ScreenUpdating = True
Set myCell = Nothing
End Sub[/PHP]

Saludos, Cacho R.

[u]P.D.[/u]

Antoni: cualquier "cosita" para agregar... ¡Ya sabes!

Link to comment
Share on other sites

Guest Cacho R
Gracias Cacho R, pero el resultado fue el mismo que el del primer archivo, con la diferencia que ya no tiene el molesto aviso del portapapeles, que opinas.

¿Qué opino?... Pues opino que por poner el énfasis en tus últimos comentarios, se "me pasó" lo de tu "columna E" (jajajajaja).

Te muestro la versión completa, entonces:

Sub Consolidar2()
'-------------------
' By Cacho Rodríguez
'-------------------
Dim arch$, myCell As Range, Rng As Range

Application.ScreenUpdating = False
Intersect([a1].CurrentRegion, [a:d]).Offset(1).Delete xlShiftUp
Set myCell = [a2]
arch = Dir(ThisWorkbook.Path & "\*.xls")

While arch <> ""
If ThisWorkbook.Name <> arch Then
With Workbooks.Open(ThisWorkbook.Path & "\" & arch, 0, True).Sheets(1)
Set Rng = Intersect(.[a1].CurrentRegion, .[a:d])
Rng.Copy
myCell.PasteSpecial: Application.CutCopyMode = xlCopy
myCell.Offset(, 4).Resize(Rng.Rows.Count) = .Parent.Name
.Parent.Close False
End With
End If
Set myCell = [a65536].End(xlUp).Offset(1)
arch = Dir
Wend

With [a1].CurrentRegion
With .Font
.Name = "Calibri"
.Size = 9
End With
.Columns.AutoFit
End With

[a1].CurrentRegion.Columns.AutoFit
Application.ScreenUpdating = True
Set Rng = Nothing: Set myCell = Nothing
End Sub[/PHP]

Sorry, entonces, por lo anterior.

Saludos, Cacho R.

Link to comment
Share on other sites

De momento lo soluciones asi:

Consideando que las lineas en blanco, podian variar de archivo a archivo, y que ninguno pasa de 3000.

Entonces quite esta parte

Set Rng = Intersect(.[a1].CurrentRegion, .["$a:$d"])

y la cambie por

Set Rng = Range("a6:k3000")

Lo cual de momento me sirve, aunque me hubiera gustado mas la idea de que no tomara en cuenta las filas vacias, para saltar de archivo.

De igual forma gracias por su atencion y ayuda, que como siempre fue genial.

Link to comment
Share on other sites

Archived

This topic is now archived and is closed to further replies.

  • Crear macros Excel

  • Posts

    • Hola a ambos, @gonzalomadrid, en Word de M365 sí funciona. Basta con que escribas =rand() para que te aparezca el texto. Si eliges =rand(2,3) te aparecerá un texto con 2 párrafos y 5 operaciones. En Excel, hasta donde yo sé, es diferente. Tal como te comenta @Abraham Valencia, dispones de =ALEATORIO() y =ALEATORIO.ENTRE() para generar números aleatorios. El propio 'Help' de Excel explica muy bien argumento y sintaxis de ambas funciones. Saludos,  
    • Hola, descargar mejor la versión (2). Saludos. MImgUrl(2).xlsm
    • Hola Medio enredado lo que escribes, pero creo que en realidad lo que buscas es ALEATORIO.ENTRE o RANDBETWEEN si usas Excel en inglés.    
    • Muchas gracias a todos por sus aportes, me han resultado de mucha utilidad, al final lo pude resolver utilizando temporalmente la funcion de reemplazar para sacar la operacion requerida y despues de eso lo volvi a dejar como estaba. Un saludo para todos
    • aquel famoso - y antiguo-    = Rand (8,5)   ¿funciona en    en excel 2019? y de paso ¿funciona en word 2019 y demás office? A mi no me funciona ni a tiros, ni ese ni   = Rand () ni Lorem Ipsum() ni nada parecido para meter texto dummy o aleatorio. ¿alguien  sabe algo?  
  • Recently Browsing

    • No registered users viewing this page.
×
×
  • Create New...

Important Information

Privacy Policy