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
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 SubSaludos.Dante Amor
Recuerda valorar la respuesta.
