Macro para copiar un rango vertical de celdas en varios libros Excel y pegarlo horizontalmente en una misma hoja de otro libro
A tod@s
En otro hilo de este foro he podido encontrar una macro que me resuelve el problema pero a medias. Así, agradeceria mucho si alguien me pueda ayudar en mi duda.
Tengo VARIOS LIBROS de Excel dónde en la primera hoja de cada libro me interesan copiar EL MISMO RANGO DE datos que se encuentran en las celdas B2 a B10 (9 celdas en rango vertical). Pues quiero pegar este rango a la "hoja1" de otro libro copiando desde A2 hasta I2 (9 Celdas en rango horizontal) para el primero libro, luego pegar de A3 hasta I3 para el segundo libro, de A4 hasta I4 para el tercer libro etc..
La primera fila de la "hoja 1" dónde estoy copiando tiene titulos prestablecidos que quiero mantener
He encontrado esta macro que copia un rango horizontal de varios libros y lo copia en una hoja pero no sé como modificarla para que me hagas lo que necesito.
Por favor cualquier comentario sería de gran ayuda.
Muchas gracias de antemano
Sub libros()
'Lee archivos del directorio y Copia un rango de la primera hoja
'Por.Dante Amor
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
ruta = ThisWorkbook.Path & "\"
archi = Dir(ruta & "*.xls*")
Set h1 = l1.Sheets("hoja1")
j = 2
Do While archi <> ""
If archi <> l1.Name Then
Set l2 = Workbooks.Open(ruta & archi)
Set h2 = l2.Sheets(1)
h2.Range("B2:O2").Copy h1.Range("A" & j)
j = j + 1
l2.Close
End If
archi = Dir()
Loop
MsgBox "Fin"
End Sub
1 respuesta
Esto lo puedes lograr fácilmente con Transpose:=True
Te puedo hacer la macro pero tengo que preguntarte un par de cosas antes para atinarle desde el primer intento y no hacer la conversación tan larga.
1-¿En cuál libro estará alojada la macro? ¿En el que se pegan los datos o en un tercer libro?
2-Los libros de donde van a copiarse los datos, ¿están todos en la misma carpeta? De ser así, ¿El libro que contiene la macro también esta en esa carpeta?
Muchas gracias Andy por tu pronta respuesta.
En cuanto a la primera pregunta , la macro está dónde se pegan los datos.
A la segunda pregunta, los ficheros están en dos carpetas diferentes. Una carpeta dónde está el fichero dónde se pegarán... Y otra carpeta para los otros ficheros.
Muchas gracias
No estoy en casa hoy hasta la noche y no tengo acceso a una PC, pero te dejare una idea por si otro experto te puede responder antes. Te había dicho que usando Transpose lo podías hacer, pero pensándolo bien, lo mejor es que coloques el rango a copiar en un Array, y luego pasas el Array a cada una de las filas.
rArray() = range(b2:b10)
Y luego range(a2:i2) = rArray()
El A2:I2 seria de fila variable, basamdose en la ultima fila con datos.
Así el proceso tendrá mejor rendimiento, es más rápido y menos cambio de un libro al otro.
Ya en casa te he hecho la macro:
Sub ZeinKallas()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim DataArray As Variant
Dim Carpeta As String: Carpeta = "C:\Users\andym\Desktop\todoexpertos\Zein Kallas\Otros Libros\"
Dim Archivo As String
Dim EsteLibro As Workbook: Set EsteLibro = ThisWorkbook
Dim OtroLibro As Workbook
Dim uF As Long
Archivo = Dir(Carpeta & "*.xls*")
Do While Archivo <> ""
uF = EsteLibro.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
Set OtroLibro = Workbooks.Open(Carpeta & Archivo)
DataArray = OtroLibro.Sheets(1).Range("B2:B10").Value
OtroLibro.Close
Set OtroLibro = Nothing
Range(Cells(uF, 1), Cells(uF, 9)).Value = WorksheetFunction.Transpose(DataArray)
Archivo = Dir()
Erase DataArray
Loop
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End SubEn la variable Dim Carpeta As String, recuerda cambiar a la ruta donde están tus libros (la que esta en mi código es una que use para hacer la prueba). y no olvides el símbolo \ al final es importante.
El código pondrá cada valor del Rango B2 a B10 de cada libro en un Array y luego lo transpondrá a la ultima fila con datos en el libro destino (el mismo que tiene la macro)
Best.
Muchísimas gracias Andy...Eres un Crack
Me has ayudado mucho y funciona de maravilla tal y como quería.
Saludos
¿Por qué no has valorado la respuesta como Excelente entonces?
