Intercambio de datos en excel con macros

Hola, en mi trabajo tengo una información que se genera día adía, parte de ella debo llevarla a una única hoja y consolidarla, de manera que seria transferir datos de por lo menos 25 archivos diferentes en un única hoja. He utilizado un código que salio en esta web, pero este solo se puede hacer dentro del mismo archivo en la hoja 1. Como podría hacer para que cada vez que lo utilice se transfiera automáticamente a la fila 4, luego el siguiente a la 5 hasta el final, los campos son alrededor de 10. No se como se puede leer un archivo diferente cada vez, esta es mi maor dificultad, no se mucho de esto. Te incluyo el código que tengo para un único archivo. Gracias
Sub copiados()
Dim HojaOrigen As Worksheet, HojaDestino As Worksheet
Dim i As Integer
'con el If compruebo las condiciones previas a la ejecución del copiado y pegado
'If HojaOrigen.Cells(2, 1).Value <> Empty And _'
'HojaOrigen.Cells(3, 1).Value <> Empty Then'
'Application.ScreenUpdating = False '
'una forma empleando el método .Paste, con dos parámetros incompatibles
'o bien definimos Destination o bien Link
Set HojaOrigen = Sheets(1)
Set HojaDestino = Sheets(2)
HojaOrigen.Range("d18").Copy
ActiveSheet.Paste HojaDestino.Range("M4")
HojaOrigen.Range("d19").Copy
ActiveSheet.Paste HojaDestino.Range("n4")
HojaOrigen.Range("d20").Copy
ActiveSheet.Paste HojaDestino.Range("b4")
HojaOrigen.Range("d21").Copy
ActiveSheet.Paste HojaDestino.Range("j4")
HojaOrigen.Range("d22").Copy
ActiveSheet.Paste HojaDestino.Range("k4")
HojaOrigen.Range("d23").Copy
ActiveSheet.Paste HojaDestino.Range("c4")
HojaOrigen.Range("j18").Copy
ActiveSheet.Paste HojaDestino.Range("e4")
HojaOrigen.Range("j19").Copy
ActiveSheet.Paste HojaDestino.Range("f4")
HojaOrigen.Range("j20").Copy
ActiveSheet.Paste HojaDestino.Range("g4")
HojaOrigen.Range("j21").Copy
ActiveSheet.Paste HojaDestino.Range("h4")
'con Link realiza un Pegar vínculo
'HojaOrigen.Cells(3, 1).Copy'
'HojaDestino.Range("A3").Activate'
'ActiveSheet.Paste link:=True'
'Realizamos un Pegado especial, en este caso como Pegar valores y Pegar fórmulas
'HojaOrigen.Cells(2, 2).Copy'
'HojaDestino.Cells(2, 2).PasteSpecial Paste:=xlValues'
HojaOrigen.Cells(3, 2).Copy
HojaDestino.Cells(3, 2).PasteSpecial Paste:=xlFormulas
'Con el método .Copy podemos indicar dónde deseamos nos copie el rango seleccionado
'realiza un copiado exacto (con formatos, fórmulas, etc)
HojaOrigen.Cells(2, 3).Copy Destination:=HojaDestino.Cells(6, 3)
HojaOrigen.Cells(3, 3).Copy Destination:=HojaDestino.Cells(3, 3)
'También podemos vincular valores o fórmulas relacionando diferentes celdas.
HojaDestino.Range("D2").Value = HojaOrigen.Range("D2").Value
HojaDestino.Range("D3").Formula = HojaOrigen.Range("D3").Formula
Application.ScreenUpdating = True
Application.CutCopyMode = False
Set HojaDestino = Nothing
Set HojaOrigen = Nothing
End Sub
Gracias por su colaboración, Saludos

1 respuesta

Respuesta
1
Cuando dices "seria transferir datos de por lo menos 25 archivos diferentes" entendemos por archivo un "libro de excel" o una pestaña de un libro.
Si entiendo lo que necesitas es consolidar 25 ibros distintos en uno, ok.
Eso seria una sola ves, puesto que si los archivos se generan día a día, una vez consolidados los 25 primeros, luego bastaría solo con consolidar el nuevo archivo diario que se genere, ¿estoy en lo cierto?. ¿O no?.
Si es eso, indicame lo siguiente
Ruta completa en donde están los archivos a leer y copiar
Nombre de la hoja de cada uno de esos libros y el rango respectivo que se debe tomar para extraer
Hola Calvuch, gracias por su atención
Aclaro algunas cosas:
1. Archivo es un libro de excel que genera cada día nuevos datos ( diferente para cada día y solo días hábiles de trabajo, había puesto 25 pero la realidad en que en cada mes solo son como mucho 22 creo).
2. Cuando se acaba el mes debo empezar lógicamente a rellenar los días hábiles específicos de ese mes, con los datos de cada día en cada fila de la hoja de destino, o sea que todos los meses los archivos o "libros" origen son diferentes.
3. Rutas de los archivos
C:\Users\Leonardo Garzon\Desktop\MAYO\PARTE TRABAJO 03052011.XLS
C:\Users\Leonardo Garzon\Desktop\MAYO\PARTE TRABAJO 04052011.XLS
C:\Users\Leonardo Garzon\Desktop\MAYO\PARTE TRABAJO 05052011.XLS
C:\Users\Leonardo Garzon\Desktop\MAYO\PARTE TRABAJO 06052011.XLS
::::::
::::::
C:\Users\Leonardo Garzon\Desktop\MAYO\PARTE TRABAJO 31052011.XLS
Donde el primer día empezaría en la fila 4 hasta que termine el mes.
4. Las celdas a leer y luego a copiar quedarían así:
llibro de origen(celda) libro de destino(celda)
d18 M4
D19 N4
D20 B4
D21 J4
D22 K4
D23 C4
J18 E4
J19 F4
J20 G4
J21 H4
Luego para el archivo (libro) de destino solo es que se copien en la fila "5" el día 03052011 y así sucesivo hasta terminar.
La cuestión es que fuera flexible para adpatarlo a cualquier mes, ya que es algo que debo consolidar todos los meses para hacer un informe de gestión.
Espero haber sido claro con la explicación, de antemano mil gracias por la colaboración, ya que esto me ahorraría mucho tiempo.
Saludo cordial
Veamos un ejemplo
1 crea un libro nuevo y guardalo donde desees
En la hoja 1 en la celda A1 pones la ruta
C:\Users\Leonardo Garzon\Desktop\MAYO\
Siempre el path ( ruta) debe terminar con \
Bien, la columna A la utilizaremos para traer el nombre de los archivos xls desde el path indicado en A1
Para eso correrás el macro "leer_directorio"
Luego una vez rescatados los nombres de los archivos correrás el macro "importar_datos"
En ese orden ok.
Ahora los macros
Desde el editor de Vba ( ALT +F11) inserta un modulo y en el pegas esto:
Sub leer_directorio()
'recorrer directorio C:\Users\Leonardo Garzon\Desktop\MAYO\
Dim m As String
Dim i As Integer
Dim directorio As String
directorio = [A1] 'PASAMOS EL PATH INDICADO EN A1
If directorio = "" Then Exit Sub
ChDir "C:\"
m = Dir(directorio & "*.xls")
i = 3
[A2] = m
Do Until m = ""
m = Dir ' sgte entrada del directorio
If m = "" Then Exit Do
Range("A" & i) = m ' CARGAMOS EL NOMBRE DEL LIBRO EN LA HOJA
i = (i + 1)
DoEvents
Loop
'Shell "WINWORD.EXE C:\pdf_core\" & Arc & "*.doc", vbNormalFocus abrir un dco word
End Sub
Sub importar_datos()
'extrae la info de cada uno de los libros de la lista
'antes recuperada con sub leer_directorio
Dim fila As Integer
Dim n As Integer
Dim i As Integer
Dim libro As String
' contamos cuantos libros utilizaremos para extraccion
n = Application.WorksheetFunction.CountA(Range("A2" & ":" & "A65536"))
If n = 0 Then Exit Sub
If [A1] = Empty Then Exit Sub
fila = 4
Application.ScreenUpdating = False
For i = 2 To n + 1
libro = Range("A" & i)
Range("m" & fila) = "=+'" & [A1] & "[" & libro & "]Hoja1'!$d$18"
Range("n" & fila) = "=+'" & [A1] & "[" & libro & "]Hoja1'!$d$19"
Range("b" & fila) = "=+'" & [A1] & "[" & libro & "]Hoja1'!$d$20"
Range("j" & fila) = "=+'" & [A1] & "[" & libro & "]Hoja1'!$d$21"
Range("k" & fila) = "=+'" & [A1] & "[" & libro & "]Hoja1'!$d$22"
Range("c" & fila) = "=+'" & [A1] & "[" & libro & "]Hoja1'!$d$23"
Range("e" & fila) = "=+'" & [A1] & "[" & libro & "]Hoja1'!$j$18"
Range("f" & fila) = "=+'" & [A1] & "[" & libro & "]Hoja1'!$j$19"
Range("g" & fila) = "=+'" & [A1] & "[" & libro & "]Hoja1'!$j$20"
Range("h" & fila) = "=+'" & [A1] & "[" & libro & "]Hoja1'!$j$21"
fila = (fila + 1)
DoEvents
Next
Application.ScreenUpdating = True
MsgBox "Terminado", vbInformation
End Sub
Grabas el libro y ya, corre los macros.
Nota:
Lo que hace este macro es insertar en las celdas que indicaste, una llamada a los libros cerrado indicados en columna A
De esta forma lo que tenemos son datos por referencia, luego solo debes tomar cada rango de datos, copiarlos y pegarlos solo como texto en el libro de resumen que tu decidas.
No quise copiar y pegar para eliminar referencias dentro del libro, pues no se que tienes en las columnas interm edias DE e I ( podrían ser funciones y si copio todo el rango te las borraría).
en fin. eso
Todo parte por poner correctamente el path en la celdas A1 y obviamente tener archivos xls en la carpeta que leerás.
Yo utilice el siguiente path a modo de ejemplo C:\prueba\
Y lo corrí con 10 archivos y funciono bien
El segundo macro desactiva el refresco en pantalla mientras se esta ejecutando, así que una vez iniciado debes esperar a que se te notifique el termino mediante un mensaje en pantalla
No olvides CERRAR la pregunta
Hola,
Implemente tu solución y me funciono perfecto, te agradezco mucho tu colaboración, gracias por compartir tu experiencia, mil y mil gracias!
Leonardo Garzón

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas