Hacer macro que pregunte cuantos datos buscar y los busque en otra hoja y luego los copie en hoja anterior

Necesito crear una macro que en una hoja1 pregunte cuantos datos buscar, luego de eso cree celdas de búsqueda según el numero anterior, en esas celdas permita escribir lo que se quiere buscar (numero de boletas) y que los busque en una hoja2, en la hoja2 hay una base de datos de cada numero de boleta con sus respectivas informaciones en filas (numero boleta:A1, Fecha:B1, Monto:C1... Etc), necesito que si la encuentra, copie los datos de la boleta en la hoja1 y si no la encuentra que notifique cuales no están.

1 Respuesta

Respuesta
1

Es más fácil hacerlo así en la hoja 1 tecleas todos los números de boletas que quieras buscar, luego corres la macro ya sea a través del panel VBA o bien colocando un botón en la hoja 1 que la active, el resultado a la derecha es como queda la hoja después de copiar la información de las boletas en casod e que no exista el numero te pondrá un mensaje al lado de la boleta.

y esta es la macro

Sub BUSQUEDA_BOLETAS()
Set h1 = Worksheets("hoja1")
Set h2 = Worksheets("hoja2")
Set datos = h1.Range("a1").CurrentRegion
Set info = h2.Range("a1").CurrentRegion
With info
    .Sort key1:=h2.Range(.Columns(1).Address), order1:=xlAscending, Header:=xlYes
End With
With datos
    R = .Rows.Count: C = .Columns.Count
    X = 1
    For i = 2 To R
        numero = .Cells(i, 1)
        CUENTA = WorksheetFunction.CountIf(info.Columns(1), numero)
        valida = CUENTA > 0: VALIDA2 = X = 1
        If valida Then
            FILA = WorksheetFunction.Match(numero, info.Columns(1), 0)
            Set origen = info.Rows(FILA).Resize(CUENTA)
            If VALIDA2 Then
                Set destino = .Cells(2, C + 3).Resize(origen.Rows.Count)
            Else
                Set destino = destino.Rows(destino.Rows.Count + 1).Resize(origen.Rows.Count)
            End If
            origen.Copy: destino.PasteSpecial
            X = X + 1
        Else
            .Cells(i, 2) = "NO EXISTE"
        End If
    Next i
    With destino.CurrentRegion
        .Rows(0).Value = info.Rows(1).Value
        .EntireColumn.AutoFit
    End With
End With
Set origen = Nothing: Set datos = Nothing
Set info = Nothing: Set destino = Nothing
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas