Pregunta para Luis Mondelo: Macro
Me ayudaste con esta macro hace algunos dias. Me surge otra inquietud mas bien necesidad. Podria ser que el valor buscado en este caso C11 no se arroje en J11. Me explico que sólo arroje en J11 los datos que estan a la derecha del valor buscado.. Algo asi como lo que hace el buscarV.
Sub busca_y_copia_VALORBUSCADO()
Sheets("hoja1").Select
Application.ScreenUpdating = False
Range("J11:L700").Clear
Sheets("basedatos").Select
Range("E1000").CurrentRegion.Sort key1:=Range("E1000"), order1:=xlAscending, Header:=xlYes,ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
valor =Sheets("hoja1").Range("C11").Value
Set busca =ActiveSheet.Range("E1000:E" & Range("E10000").End(xlUp).Row).Find(valor, LookIn:=xlValues,lookat:=xlWhole)
If Not busca Is Nothing Then
ubica = busca.Address
Range(ubica).Select
fila = Range(ubica).Row
contarsi =Application.WorksheetFunction.CountIf(Range("E1000:E" & Range("E10000").End(xlUp).Row), valor)
Range(Cells(fila, 5), Cells(fila + contarsi - 1, 7)).Copy
Sheets("hoja1").Select
Range("J11").PasteSpecial xlPasteAll
End If
Application.ScreenUpdating = True
End Sub
1 Respuesta
No me preguntaste pero me meto a responder...
En esta línea de código, prueba cambiando el número 5 por un 6.
-------------------
Range(Cells(fila, 5), Cells(fila + contarsi - 1, 7)). Copy
--------------------
Que tengas un EXCELente día!
Jorge A. Rodríguez Lopera
Hola! Jorge,
Muchas gracias por meterte . Me estaba ahogando en un vaso de agua al parecer.
Excelente. es lo que quería.!
Aprovechando. otra consulta se puede llamar varias hojas a la vez,
Sheets("hoja1").Select.
osea son 5 hojas a donde tengo q traspasar la búsqueda.
algo como sheets("hoja1", "hoja2", "hoja3" hasta la 5) o definitivamente tendría que escribir 5 veces el código para llamar las hojas una por una.
Si prefieres qe consulte en el tablón como otra pregunta no hay problema, y finalizo esta.
Puedes crear un ciclo cambiando las líneas:
Sheets("hoja1").Select
Range("J11"). PasteSpecial xlPasteAll
Por el siguiente código
---------------------------------------------
For h=1 to 5
Sheets("hoja" & h).Select
Activesheet.Range("J11").PasteSpecial xlPasteAll
Next h
----------------------------------------------
También puedes utilizar una matriz de hojas:
------------------------------------
Sheets(Array("Hoja1", "Hoja2", "Hoja3", "Hoja4","Hoja5")).Select
Sheets("Hoja1").Activate
Range("J11").Select
ActiveSheet. Paste
----------------------------------------------
Espero que esto solucione tu necesidad.
Que tengas una EXCELente noche!
Jorge A. Rodríguez Lopera
PD. No te preocupes por cómo preguntas... le regalamos los puntos al señor Luis Mondelo, que bien se los ha ganado con todos los aportes que ha dado :-)
Los puntos son para ti de todas maneras!
Mira quedo asi la macro. Pero me tira un mensaje como "subindice fuera del intervalo". Los datos de todas maneras me los arroja simultaneamente en j11 desde comando boton de hoja 1 a pesar del mensaje. Ahora, es como lo que tengo en mente. sin embargo lo ideal seria que comandara los datos desde los botones de cada hoja idependiente. No todas con el boton de hoja 1. Será que tengo que cambiar en donde dice "hoja1" por "hoja & h" ???
Sub busca_y_copia_buscar()
Sheets("hoja1").Select ' cambiar aqui por "hoja & h" tambien??????
Application.ScreenUpdating = False
Range("J11:L700").Clear
Sheets("basedatos").Select
Range("E1000").CurrentRegion.Sort key1:=Range("E1000"), order1:=xlAscending, Header:=xlYes, ordercustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
valor = Sheets("hoja1").Range("C11").Value ' cambiar aqui por "hoja & h" tambien??????
Set busca = ActiveSheet.Range("E1000:E" & Range("E10000").End(xlUp).Row).Find(valor, LookIn:=xlValues, lookat:=xlWhole)
If Not busca Is Nothing Then
ubica = busca.Address
Range(ubica).Select
fila = Range(ubica).Row
contarsi = Application.WorksheetFunction.CountIf(Range("E1000:E" & Range("E10000").End(xlUp).Row), valor)
Range(Cells(fila, 6), Cells(fila + contarsi - 1, 7)).Copy
For h = 1 To 5
Sheets("hoja" & h).Select
ActiveSheet.Range("J11").PasteSpecial xlPasteAll
Next h
End If
Application.ScreenUpdating = True
End SubMe responde cuando puedas.
Buenas noches.
OK. Ahora estoy en mi trabajo. Trataré de responderte esta misma noche desde mi casa.
