Buscar datos y según sea el dato encontrado pegarlo en hojas distintas.
Buscando en los foros encontré la siguiente macro; filalibre = Sheets("hoja2").Range("a65000").End(xlUp).Row + 1
dato = InputBox("que dato buscamos???")
If dato = "" Then Exit Sub
Set buscado = ActiveSheet.Range("a1:a" & Range("a65000").End(xlUp).Row).Find(dato, LookIn:=xlValues, lookat:=xlWhole)
If Not buscado Is Nothing Then
ubica = buscado.Address
Do
buscado.EntireRow.Copy Destination:=Sheets("hoja2").Cells(filalibre, 1)
filalibre = filalibre + 1
Set buscado = ActiveSheet.Range("a1:a" & Range("a65000").End(xlUp).Row).FindNext(buscado)
Loop While Not buscado Is Nothing And buscado.Address <> ubica
End If
Lo que hace es: busca un dato(podríamos llamarlo id), si se encuentra, copia a la hoja2 todos los registros que incluyan la id.
Lo que no consigo hacer es que cada uno de los cuatro ID(1,2,3,4) que tengo se pasen a distintas hojas(con la macro de arriba los registros, se copian a la hoja2)si la ID= 1 esos los registros con esa clave, se deben ir a la hoja dos, Si la ID busca es 2 todos los registros con ID=2, deben ir a la hoja 3 y asi sucesivamente.
¿Alguien me puede ayudar a colocar las condiciones?
2 respuestas
Utiliza lo siguiente
Sub copia()
'Actualizado.Por.DAM
dato = InputBox("que dato buscamos???")
If dato = "" Then Exit Sub
Set r = ActiveSheet.Range("a1:a" & Range("a65000").End(xlUp).Row)
Set buscado = r.Find(dato, LookIn:=xlValues, lookat:=xlWhole)
If Not buscado Is Nothing Then
ubica = buscado.Address
Do
hoja = "hoja" & dato + 1
filalibre = Sheets(hoja).Range("a65000").End(xlUp).Row + 1
buscado.EntireRow.Copy Destination:=Sheets(hoja).Cells(filalibre, 1)
filalibre = filalibre + 1
Set buscado = r.FindNext(buscado)
Loop While Not buscado Is Nothing And buscado.Address <> ubica
End If
End SubSi tienes más datos (1,2,3,4) deberás tener más hojas.
Si escribes un dato que no tenga hoja, por ejemplo el 70, y no tienes la hoja 71, no se va a copiar.
Saludos. DAM
Si es lo que necesitas.
DAM, gracias la he estado probando, y funciona bien, excepto con el ID 2, se supone que saldría en la HOJA3 pero no aparece, y de paso me podrías explicar la parte que hace el copy/paste?
El problema puede ser de datos
Revisa que la hoja se llame "Hoja3" sin espacios
Revisa que el Id 2 en la hoja1 no tenga espacios y que existan ID con el número 2
Esta línea hacer el "copy-paste"
buscado.EntireRow.Copy Destination:=Sheets(hoja).Cells(filalibre, 1)
Toma la línea entera del valor encontrado y en automático la copia a la hoja en la última fila, previamente la hoja se llama "hoja" + el ID, también previamente se buscó la última fila y se asigno el número de la última fila a la variable filalibre.
Saludos. DAM
No olvides finalizar la pregunta.
Esta macro trabaja sobre la hoja activa y copia a la Hoja2 porque así lo indica esta línea:
buscado.EntireRow.Copy Destination:=Sheets("hoja2").Cells(filalibre, 1)Para personalizar el destino hay varias maneras, elegí la que mejor se adapta a lo tuyo:
1- reemplazar en la instrucción el nombre de tu hoja
buscado.EntireRow.Copy Destination:=Sheets("planta1").Cells(filalibre, 1)
2- solicitarla con otro inputbox:
hojita = Inputbox ("ingresa nombre de la hoja destino"
Y luego en la instrucción usá ese nombre de hoja, ahora sin comillas:
buscado.EntireRow.Copy Destination:=Sheets(hojita).Cells(filalibre, 1)
3- Tomarla como contenido de otra celda: Suponiendo que en H1 colocás el nombre de la hoja destino sería entonces:
buscado.EntireRow.Copy Destination:=Sheets(Range("H1").value).Cells(filalibre, 1)
Creo que te presenté todas las opciones, elegí alguna y no olvides finalizar la consulta.
Sdos
Elsa
Últimos días!