Macro para buscar en otra hoja una columna completa y copiar sus respectivas en otra hoja
Nuevamente hago una pregunta, esta vez cambia un poquito mi consulta, es un poco mas simple:
Necesito una macro que al seleccionar datos de la columna N° Boletas de la Hoja1 y luego dar click en el botón "Buscar" me busque en la Hoja2 los datos seleccionados anteriormente en la columna N° Boleta de la Hoja2 y copie sus respectivas filas En una nueva hoja Hoja3. En caso de no encontrar algun dato que escriba en cada celda "No encontrado". Necesito que las hojas tengan la siguiente estructura:
Hoja1 (los datos están en G)
Hoja2
Hoja3
Si no quedó clara mi pregunta, diganme para poderla aclarar.
Ejecuta la siguiente macro en la hoja1
Sub Buscar_Boletas()
'Por Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
Set h3 = Sheets("Hoja3")
'
h3.Rows("2:" & Rows.Count).ClearContents
Set rango = Selection
If rango.Columns.Count > 1 Or rango.Cells(1, 1).Column <> Columns("G").Column Then
MsgBox "Selecciona solamente datos de la columna "
Exit Sub
End If
'
j = 2
For Each boleta In Selection
num = boleta.Value
If num <> "" Then
Set b = h2.Columns("A").Find(num, lookat:=xlWhole)
If Not b Is Nothing Then
h2.Rows(boleta.Row).Copy
h3.Rows(j).PasteSpecial xlValues
j = j + 1
End If
End If
Next
MsgBox "Fin"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
Excelente, funciona muy bien, sin embargo el botón de buscar se me desaparece a medida que avanzo hacia abajo de la hoja, ¿cómo puedo hacer para que el botón buscar quede como un botón flotante?
Lo otro es que el codigo no indica cuales son las boletas que faltan, ¿que debo agregar en el codigo para que se muestren las faltantes? ques emuestren en la Hoja3 idealmente
Listo, en caso de no encontrar la boleta en la hoja2, aparecerá en la hoja1 "No encontrado"
Sub Buscar_Boletas()
'Por Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
Set h3 = Sheets("Hoja3")
'
h3.Rows("2:" & Rows.Count).ClearContents
Set rango = Selection
If rango.Columns.Count > 1 Or rango.Cells(1, 1).Column <> Columns("G").Column Then
MsgBox "Selecciona solamente datos de la columna "
Exit Sub
End If
'
j = 2
For Each boleta In Selection
num = boleta.Value
If num <> "" Then
Set b = h2.Columns("A").Find(num, lookat:=xlWhole)
If Not b Is Nothing Then
h2.Rows(boleta.Row).Copy
h3.Rows(j).PasteSpecial xlValues
j = j + 1
Else
boleta.Offset(0, 1).Value = "No encontrado"
End If
End If
Next
MsgBox "Fin"
End SubLo del botón deberás buscar alguna respuesta sobre el tema o crear una nueva pregunta.
Revisa la siguiente respuesta
