Macro para comprarar datos con operador = y copiar si no existe en una hoja diferente

Necesito un macro que haga lo siguiente:

Tengo una hoja de trabajo llamada "Inventario" a esa hoja copeo los datos de la Hoja_1 y en la fila 5 marco con 1 los datos que tengo

Con este código:

Sub copia_Hoja_1()
        r = 2
    Do While Sheets("Hoja_1").Cells(r, 1).Value <> ""
        Sheets("Inventario").Cells(r, 1).Value = Sheets("Hoja_1").Cells(r, 5).Value
        Sheets("Inventario").Cells(r, 2).Value = Sheets("Hoja_1").Cells(r, 8).Value
        Sheets("Inventario").Cells(r, 3).Value = Sheets("Hoja_1").Cells(r, 10).Value
        Sheets("Inventario").Cells(r, 4).Value = Sheets("Hoja_1").Cells(r, 3).Value
        Sheets("Inventario").Cells(r, 5).Value = 1
        r = r + 1
        Loop
End Sub

Después quiero que con un macro:

Compare datos de Hoja_2 que serian las columnas (7,8,, 5,12) con los datos de inventario (1,2,3,4,5 si se puede con el operador "=" (si hay algún otro método es bienvenido)

Si hay dato repetido que me marque en la columna (6) con un 1 refiriendoce que esta en la hoja_2

Y si no hay dato que copie y marque con 1 que esta en la hoja_2

Espero me puedan ayudar y no sea confuso lo que pido

1 respuesta

Respuesta
1

Te envié un macro para copiar los datos, dime si es lo que necesitas o hay que realizar cambios en la macro:

Sub Comparativo()
'Por.Dante Amor
    Set h1 = Sheets("inventario")
    Set h2 = Sheets("bd_2")
    '
    For i = 2 To h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row
        Set b = h1.Columns("C").Find(h2.Cells(i, "E"), lookat:=xlWhole) 'busca serie
        If b Is Nothing Then
            Set c = h1.Columns("D").Find(h2.Cells(i, "L"), lookat:=xlWhole) 'busca dirección
            If c Is Nothing Then
                u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 1
                h1.Cells(u, "A") = h2.Cells(i, 7)
                h1.Cells(u, "B") = h2.Cells(i, 8)
                h1.Cells(u, "C") = h2.Cells(i, 5)
                h1.Cells(u, "D") = h2.Cells(i, 12)
                h1.Cells(u, "F") = 1
            End If
        End If
    Next
End Sub

Hola gracias dante por tomarte el tiempo de escribir una respuesta

Mira realice el siguiente macro

La primer parte copia la bd1 a inventario y elimina los espacios entre los datos

La segunda parte es la que compara la "bd2" con los valores de "inventario"

Solo que me marca error en una de las líneas

No se si puedan ayudarme en depurar el código

Saludos

Sub copia()        r = 2    Do While Sheets("BD1").Cells(r, 1).Value <> ""        If Sheets("BD1").Cells(r, 8).Value <> "IP Device" Then            Sheets("Inventario").Cells(r, 1).Value = Sheets("BD1").Cells(r, 5).Value            Sheets("Inventario").Cells(r, 2).Value = Sheets("BD1").Cells(r, 8).Value            Sheets("Inventario").Cells(r, 3).Value = Sheets("BD1").Cells(r, 10).Value            Sheets("Inventario").Cells(r, 4).Value = Sheets("BD1").Cells(r, 3).Value            Sheets("Inventario").Cells(r, 5).Value = 1        End If        r = r + 1        Loop        Cells.SpecialCells(xlCellTypeBlanks).Delete xlUpEnd SubSub compara_se_BD2()    r_i = 2    r_c = 2    existe = 0    Do While Sheets("BD2").Cells(r_c, 1).Value <> ""       Do While Sheets("Inventario").Cells(r_i, 5).Value <> ""        If Sheets("Inventario").Cells(r_i, 3).Value = Sheets("BD2").Cells(r_c, 5).Value Then            Sheets("Inventario").Cells(r_i, 6).Value = 1            existe = 1            Exit Do        End If        r_i = r_i + 1       Loop       If existe = 1 Then            Sheets("Inventario").Cells(r, 1).Value = Sheets("BD2").Cells(r, 7).Value            Sheets("Inventario").Cells(r, 2).Value = Sheets("BD2").Cells(r, 8).Value            Sheets("Inventario").Cells(r, 3).Value = Sheets("BD2").Cells(r, 5).Value            Sheets("Inventario").Cells(r, 4).Value = Sheets("BD2").Cells(r, 12).Value            Sheets("Inventario").Cells(r, 6).Value = 1        End If       r_i = 2       r_c = r_c + 1       existe = 0    LoopEnd Sub

Antes de pasar a otra macro, revisa la macro que te envié.

Si la macro funciona, entonces valora la respuesta.

Si quieres que revise tu macro, entonces crea una nueva pregunta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas