Comparar Hojas Agregar y Modificar registros

Saludos a todos

Me podrían apoyar por favor con el código de una macro para realizar lo siguiente

Tengo dos hojas (Histórico y Actual), con columnaA = ID, colB=Descripción,ColC= Importe, ColD= Tipo, ColE=Fecha y ColumnaF=Status, deseo buscar uno por uno el ID de la hoja actual en la hoja Histórico, e ir comparando los datos de las columnas, en caso de que se haya modificado algún datos mostrar un mensaje Desea modificar el ID=??? Columna=???  el valor de la celda por el nuevo valor de la hoja actual ??? Y pintar la celda de color azul

Los nuevos registros (ID) que no estén en la hoja histórico agregarlos al final de la hoja históricos y pintar las celdas de color amarillo

Agradezco de antemano su apoyo

Saludos

1 Respuesta

Respuesta
1

Te anexo la macro para la comparación:

Sub comparar()
'Por.Dante Amor
    Set h1 = Sheets("Actual")
    Set h2 = Sheets("Historico")
    tit = Array("", "ID", "Descripción", "Importe", "Tipo", "Fecha", "Status")
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row
        Set b = h2.Columns("A").Find(h1.Cells(i, "A"), lookat:=xlWhole)
        If Not b Is Nothing Then
            For j = 2 To 6
                If h1.Cells(i, j) <> h2.Cells(b.Row, j) Then
                    res = MsgBox("Desea modificar el ID = " & b.Value & _
                          ". Columna = " & tit(j) & vbCr & vbCr & _
                          "El valor: " & h2.Cells(b.Row, j) & _
                          ". Por el nuevo valor de la hoja actual: " & h1.Cells(i, j), _
                          vbYesNo, "Fecha: " & Date)
                    If res = vbYes Then
                        h2.Cells(b.Row, j) = h1.Cells(i, j)
                        h2.Cells(b.Row, j).Interior.ColorIndex = 41
                    End If
                End If
            Next
        Else
            h1.Rows(i).Copy h2.Rows(h2.Range("A" & Rows.Count).End(xlUp).Row + 1)
        End If
    Next
    MsgBox "Comparación terminada", vbInformation, "Fecha: " & Date
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas