Macro para Buscar un Registro y Eliminarlos continuación

Lo que necesito ahora es que habrá y cierre el libro 2.

¿Me puede ayudar?

Sub buscar()
    'Por. DAM
    'Act. Adriel Ortiz
    '
    Set l1 = ThisWorkbook
        Set h1 = l1.Sheets("Hoja1")
    Set l2 = Workbooks("Libro2.xlsx")          'nombre libro2
        Set h2 = l2.Sheets("Hoja2")            'hoja a buscar en libro2
    '
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    Set b = h2.Range("A8:A" & u).Find(h1.Range("A7"), lookat:=xlWhole)
    If Not b Is Nothing Then
        If MsgBox("Desea cargar el codigo " & h2.Cells(b.Row, "A") _
            , vbQuestion & vbYesNo, "Cargar codigo") = vbYes Then _
            h2.Rows(b.Row).Delete
    Else
        MsgBox "El código buscado no existe", vbCritical
        h1.Range("A7").Select
    End If
End Sub

1 Respuesta

Respuesta
1

[Hola

Te paso la macro 

Sub buscarxx()
 '//Todoexpertos
 '[Por Adriel Ortiz
 '
 '
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 '
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja1")
    '
    ruta = "C:\Users\Aortiz\Desktop\practica\"
    libro2 = "libro2.xlsx"
    '
    Set l2 = Workbooks.Open(Filename:=ruta & libro2)
    Set h2 = l2.Sheets("Hoja1")
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    Set b = h2.Range("A8:A" & u).Find(h1.Range("A7"), lookat:=xlWhole)
    If Not b Is Nothing Then
        If MsgBox("Desea eliminar el registro: " & h2.Cells(b.Row, "A") _
            , vbQuestion & vbYesNo, "ELIMINAR") = vbYes Then _
            h2.Rows(b.Row).Delete
    l2.Save
    l2.Close False
    MsgBox "fin"
    Else
        MsgBox "El código buscado no existe", vbCritical
        h1.Range("A7").Select
    End If
    '
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

No olvides de cambiar la ruta donde tienes el libro 2


Valora la respuesta para finalizar saludos!

Probé la macro pero me da un erro de compilación se requiere un objeto y me mara SET =B.

¿

Estará algo malo?

Y si cambie la ruta

 ruta = "C:\Users\Aortiz\Desktop\practica\"
Libro2 = "libro2.xlsx"

fíjate que el nombre y la extensión(.xlsx) del segundo libro esté correctamente

'

La macro busca en la Hoja1 del libro2

Están correctas el nombre y la extensión. Sigue dando el mismo error

Sub buscarxx()
 '//Todoexpertos
 '[Por Adriel Ortiz
 '
 '
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 '
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("hoja51")
    '
    ruta = "C:\Users\JOSE\Desktop\TODO ESCRITORIO\menu\"
    libro2 = "libro2.xlsx"
    '
    Set l2 = Workbooks.Open(Filename:=ruta & libro2)
    Set h2 = l2.Sheets("Hoja1")
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    Set B = h2.Range("A8:A" & u).Find(h1.Range("D21"), lookat:=xlWhole)
    If Not B Is Nothing Then
        If MsgBox("Desea eliminar el registro: " & h2.Cells(B.Row, "A") _
            , vbQuestion & vbYesNo, "ELIMINAR") = vbYes Then _
            h2.Rows(B.Row).Delete
    l2.Save
    l2.Close False
    MsgBox "fin"
    Else
        MsgBox "El código buscado no existe", vbCritical
        h1.Range("D21").Select
    End If
    '
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Valore si haber terminado perdón aquí te mande la macro

Todo está correcto, que error te sale envíame una imagen

OK mira ya me funciono. No se que fue lo que paso. OK el ultimo favor es el siguiente. ¿Se puede hacer que no se vea cuando se abre el libro 2? Y lo otro me gustaría dejar la macro de 2 formas un botón que busque y borre así como esta ahora. Y la otra un BOTÓN para buscar y otro BOTÓN para borrar pero siempre que no se vea que se abre el libro 2. No se si es mucho pedir. GRACIAS

Sub buscarxx()
 '//Todoexpertos
 '[Por Adriel Ortiz
 '
 '
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 '
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("hoja51")
    '
    ruta = "C:\Users\JOSE\Desktop\TODO ESCRITORIO\menu\"
    libro2 = "libro2.xlsx"
    '
    Set l2 = Workbooks.Open(Filename:=ruta & libro2)
    Set h2 = l2.Sheets("Hoja1")
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    Set B = h2.Range("A8:A" & u).Find(h1.Range("A7"), lookat:=xlWhole)
    If Not B Is Nothing Then
        If MsgBox("Desea eliminar el registro: " & h2.Cells(B.Row, "A") _
            , vbQuestion & vbYesNo, "ELIMINAR") = vbYes Then _
            h2.Rows(B.Row).Delete
    l2.Save
    l2.Close False
    MsgBox "fin"
    Else
        MsgBox "El código buscado no existe", vbCritical
        h1.Range("A7").Select
    End If
    '
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

No es posible ocultar el proceso cuando abre el libro


Para eliminar ya lo tienes

Para buscar es casi similar, pero para seleccionar el dato encontrado hay tener abierto el libro2

Sub buscarxx()
 '//Todoexpertos
 '[Por Adriel Ortiz
 '
 '
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 '
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("hoja51")
    '
    ruta = "C:\Users\JOSE\Desktop\TODO ESCRITORIO\menu\"
    libro2 = "libro2.xlsx"
    '
    dato = h1.Range("A7")       ' Dato a buscar
    Set l2 = Workbooks.Open(Filename:=ruta & libro2)
    Set h2 = l2.Sheets("Hoja1")
    u = h2.Range("A" & Rows.Count).End(xlUp).Row
    Set b = h2.Range("A8:A" & u).Find(dato, lookat:=xlWhole)
    If Not b Is Nothing Then
        b.Select        ' selecciona dato encontrado
    'l2.Save            ' guarda
    'l2.Close False     ' cierra el libro
    MsgBox '"
    Else
        MsgBox "El código buscado no existe", vbCritical
        h1.Range("A7").Select
    End If
    '
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Ya todo esta muy bien. Siempre y cuando sea libro1 nuevo. Pero si es un libro existente que tiene varias hojas me da el error de compilación y me marca set b=

Tienes que especificar bien el nombre de la hoja del libro a buscar de caso contrario te lanza error

Añade tu respuesta

Haz clic para o
El autor de la pregunta ya no la sigue por lo que es posible que no reciba tu respuesta.

Más respuestas relacionadas