Buscar dato, copiar rango y pegar traspuesto
Dios les bendiga, primero que todo saludar a todos los expertos que han sido de gran ayuda en mi proceso de formación laboral y agradecer a todoexpertos por crear esta pagina la cual ha sido de mucha ayuda.
Tengo un libro compuesto por dos hojas (hoja1 y hoja2) en el primero tengo en el rango de A1:A10000 los datos como siguen un código numérico y en la 45 celdas siguientes los números del 1 al 45 rellenado con color. Lo que quiero hacer es que en al ingresar el código en la hoja2 en la celda A10 busque este código en la hoja1 en el rango dispuesto (A1:A10000) me copie el rango 45 celdas hacia abajo donde se encuentra el código numérico y la pegue de forma traspuesta en la hoja2 en el rango L10:BD10. Ejemplo:
Si escribo en la celda A10 el código numérico 4568 en la hoja2. Se busca el valor en la hoja1 en el rango A1:A10000 y encuentra que este valor esta en la celda A3020 me copie el rango 45 celdas hacia abajo inmediata a esta es decir A3021:A3065 y lo pegue en la hoja2 de forma traspuesta en el rango L10:BD10. Y así sucesivamente para cada código numérico ingresado en la hoja2.
1 respuesta
Esta es la macro que necesitas:
Sub proceso()
'por luismondelo
Sheets("hoja2").Select
valor = Range("a10").Value
Set busca = Sheets("hoja1").Range("a1:a10000").Find(valor, LookIn:=xlValues, lookat:=xlWhole)
If Not busca Is Nothing Then
ubica = busca.Address
Sheets("hoja1").Select
Range(ubica).Offset(1, 0).Select
Range(ActiveCell, ActiveCell.Offset(44, 0)).Copy
Sheets("hoja2").Range("l10").PasteSpecial Paste:=xlValues, Transpose:=True
End If
Sheets("hoja2").Select
End Subrecuerda finalizar
Dios te bendiga compañero, gracias por tu pronta respuesta. La macro funciona perfecto, como hago para las celdas siguientes en la hoja2 es decir si ingreso los códigos desde A10:A200 y realice la misma operación solo que para las celdas siguientes. Ya que la macro que describes hace solo para el código en a10 y lo que busco es para el rango a10:a200
es decir buscar el dato de A11 copiar rango y pegar en L11, buscar dato de A12 copiar rango y pegar en L12 y así sucesivamente hasta A200.
De antemano gracias
Entonces la macro quedaría así:
Sub proceso()
'por luismondelo
fila =10
Sheets("hoja2").Select
range("a10").select
do while activecell.value <>""
valor = activecell.Value
Set busca = Sheets("hoja1").Range("a1:a10000").Find(valor, LookIn:=xlValues, lookat:=xlWhole)
If Not busca Is Nothing Then
ubica = busca.Address
Sheets("hoja1").Select
Range(ubica).Offset(1, 0).Select
Range(ActiveCell, ActiveCell.Offset(44, 0)).Copy
Sheets("hoja2").cells(fila,12).PasteSpecial Paste:=xlValues, Transpose:=True
fila = fila+1
End If
activecell.offset(1,0).select
loop
Sheets("hoja2").Select
End Subrecuerda finalizar
