Utilizar Find en macros o procedimiento similar

Necesitaría que me ayudarais a buscar los distintos nombres de una persona, copiar toda la fila donde aparece, pegarla en otra hoja. Esto con cada nombre que se encuentre igual al indicado por nosotros.
Yo lo que he intentado son dos formas pero ninguna me funciona:
Do
Sheets(1).Select
Set c = Cells.Find(ComboBox1.Value, LookIn:=xlValues)
c.Select
c.EntireRow.Select
Selection.Copy
Sheets(2).Select
Cells(i, 1).Select
ActiveSheet.Paste
i = i + 1
ActiveCell.Offset(1, 0).Activate
Loop While c.Value <> ""
Esto me crea un bucle infinito y nada, no consigo solucionarlo para que funcione bien. Otra forma que he intentado es con un procedimiento buscar que me he hecho yo, pero también me da error:
Do
Sheets(1).Select
Casilla = Buscar("Hoja1", inicial, combox1.Value)
Range(Casilla).Select
ActiveCell.EntireRow.Select
Selection.Copy
Sheets(2).Select
Cells(i, 1).Select
ActiveSheet.Paste
i = i + 1
ActiveSheet.Offset(1, 0).Activate
inicial = ActiveCell.Offset(1, 0).Select
Loop While Range(Casilla).Address = "A1"
Function Buscar(Hoja As String, Casilla_Inicial As String, SDM As String) As String
Dim posicion As String
Worksheets(Hoja).Activate
ActiveSheet.Range(Casilla_Inicial).Activate
Do While (ActiveCell.Value <> SDM) And (ActiveCell.Value <> "")
ActiveCell.Offset(1, 0).Activate
Loop
If ActiveCell.Value = SDM Then
Buscar = ActiveCell.Address
Else
Buscar = "A1" 'no encontrado, posiciona en A1
End If
End Function
Por favor ayuda! Guiarme un poco para poder continuar please!

1 Respuesta

Respuesta
1
He Modificado la primera rutina que envías
Prueba con estos cambios y me avisas
Sheets(1).Select
Set c = Cells.Find(ComboBox1.Value, LookIn:=xlValues)
On Local Error Resume Next
c.Select
If Err.Number = 0 Then
c.EntireRow.Select
Selection.Copy
Sheets(2).Select
Range("A1").Select
If IsEmpty(Range("A1").Value) = False Then
If IsEmpty(Range("A2").Value) = True Then
Cells(ActiveCell.Row + 1, 1).Select
Else
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate
End If
End If
ActiveSheet.Paste
Else
MsgBox "Nombre No Encontrado", vbExclamation, "No Encontrado"
End If
On Error GoTo 0
Muchas gracias por contestar.
Lo acabo de probar pero solamente me copia la primera linea. ¿Cómo pongo el bucle para que me ponga todos los datos en la hoja nueva? Tengo en una hoja algo así:
Nombre caso numero
javier 4 3435
elena 7 6666
Eduardo 6 8889
javier 8 980
Y quiero que en la hoja dos quede:
Nombre caso numero
javier 4 3435
javier 8 980
Tendría que quedar así cuando pongo en el combobox el nombre de javier, si pusiera el de Elena tendría que salir el de Elena...
Muchas gracias
Realice algunas modificaciones chequealas y me avisas.
Dim Buscar_Proximo As Double
Dim Cantidad_Registros As Double
Dim Ultima_Fila_Celda_Encontrada As Double
Dim Fila_Celda_Encontrada As Double
Cantidad_Registros = 0
Ultima_Fila_Celda_Encontrada = 0
Fila_Celda_Encontrada = 0
Do While Err.Number = 0 And Ultima_Fila_Celda_Encontrada < Fila_Celda_Encontrada + 1
Sheets(1).Select
Range("A1").Select
Cells.Find(ComboBox1.Value, LookIn:=xlValues).Activate
Buscar_Proximo = 0
Do While Cantidad_Registros > Buscar_Proximo
Cells.FindNext(After:=ActiveCell).Activate
Buscar_Proximo = Buscar_Proximo + 1
Loop
Fila_Celda_Encontrada = ActiveCell.Row
On Local Error Resume Next
If Err.Number = 0 And Ultima_Fila_Celda_Encontrada < Fila_Celda_Encontrada + 1 Then
Cantidad_Registros = Cantidad_Registros + 1
Ultima_Fila_Celda_Encontrada = ActiveCell.Row
ActiveCell.EntireRow.Select
Selection.Copy
Sheets(2).Select
Range("A1").Select
If IsEmpty(Range("A1").Value) = False Then
If IsEmpty(Range("A2").Value) = True Then
Cells(ActiveCell.Row + 1, 1).Select
Else
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Activate
End If
End If
ActiveSheet.Paste
Application.CutCopyMode = False
Else
If Ultima_Fila_Celda_Encontrada < Fila_Celda_Encontrada + 1 Then
MsgBox "Nombre No Encontrado", vbExclamation, "No Encontrado"
End If
End If
Loop
On Error GoTo 0

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Copiar datos de una pestaña a otra con macro

No domino para nada las macros y necesito su ayuda, tengo un archivo con varias pestañas con igual formato y una pestaña más que llamaré "Total" donde pienso concentrar lo contenido en esas pestañas. Necesito copiar el texto de 2 columnas de cada...
1 respuesta

Macro concatenar

Quisiera saber como concateno por medio de una macro un libro que tiene un rango de datos de a hasta h con muchas filas, por lo que quiero primero insertar una columna en A y ahí en a1 concatenar lo que este en e1 Y B1. Lo he estado intentando así.....
1 respuesta

¿Cómo sumar 2 label y 2 textbox,y mostrar suma en un 3er label?

Estoy haciendo un formulario en excel 2007, con un combobox que filtra, dos label que muestra datos del filtro, y dos text box, en la cual agrego o resto. Tanto en los dos labels como en los dos textbox se maneja con números. Cómo hacer que en un...
1 respuesta

Filtro con hipervínculo

Tengo un fichero Excel con un montón de códigos numéricos que van desde el 00000 al 99999. Lo que quiero hacer es otro fichero Excel que al poner un valor en una celda que estará dentro del rango anterior, por ejemplo 11111, haciendo click en esta...
1 respuesta

Optimizar macro

La verdad soy nuevo con las macros asi que no se mucho de códigos, pero quisiera poder optimizar el siguiente código., ya que, si realiza la tarea que necesito pero me parece que puede optimizarse; lo que más necesito es que cuando ya tengo muchos...
2 respuestas

¿Cómo modificar macro?

Esta macro lo que hace es básicamente copiar datos de una hoja a las otras dos hojas en un libro excel, pero cuando hay una formula copia la formula, ¿Cómo puedo hacer para que en lugar de copiar la formula, sólo copie los datos?. Gracias por su...
1 respuesta

"VLOOKUP" la segunda y la tercera coincidencia

Buscando un dato con "VLOOKUP" me da la primera coincidencia pero tiene 3 coincidencias como pedir la segunda y la tercera
1 respuesta