Copiar filas iguales y poner diferencia

Recibe un cordial saludo por este medio

Por favor me podrás ayudar con una macro para realizar lo siguiente

en la hoja llamada Real tengo los siguientes datos

Col A ColB ColC ColD ColE ColF

nomA 10 35 5 22 30

ejm2 50 25 10 10 2

prue1 100 50 5 150 40

en la hoja llamada Estimado tengo los siguientes datos
Col A ColB ColC ColD ColE ColF
nomA 9 35 25 22 32
e2jm 50 25 10 10 2
prue1 100 50 5 150 39

2sdf 1 2 80 0 50

La hoja Resumen me debería cortar las filas de la columna "A" que aparezcan en hoja Real y Estimado y poder sacar la diferencia entre columnas de la B a la F, asi debería de quedar

Col A ColB ColC ColD ColE ColF Hoja
nomA 10 35 5 22 30 Real

nomA 9 35 25 22 32 Estimado

Dif 1 0 -20 0 -2

fila en blanco
prue1 100 50 5 150 40 Real

prue1 100 50 5 150 39 Estimado

Dif 0 0 0 0 1

En este caso la Real solo debería de tener la fila 1 con los títulos y el registro Ejm2

La hoja Estimado solo debería de tener la fila 1 con los títulos y los registros e2jm y 2sdf

Conclusión: la idea es comparar la columna A de la hoja real Vs la columna A de la Hoja Estimado, los registros que coincidan se corta la fila y se pone en la hoja Resumen sacando diferencias desde la columna B a la columna F, y dejando en la hoja Real y Estimado las que no hubo coincidencia

El numero de fila en las hojas real y estimado es variable, igual para ejemplificar solo puse hasta la columna F pero en realidad son 30 columnas

Espero haberme explicado. Agradezco de antemano tu apoyo. Saludos

1

1 Respuesta

4.578.600 pts. Sancho, si los perros ladran ...

Sigue las Instrucciones para ejecutar la macro
1. Abre tu hoja de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Para ejecutarla presiona F5

Sub copiar_filas_iguales()
'por.Dam
Set h1 = Sheets("Real")
Set h2 = Sheets("Estimado")
Set h3 = Sheets("Resumen")
Application.ScreenUpdating = False
h3.Cells.Clear
h1.Select
h1.Rows(1).Copy h3.Cells(1, 1) 'copia títulos
j = 2
ufila = h1.Range("A" & Rows.Count).End(xlUp).Row
For i = ufila To 2 Step -1
    h2.Select
    Set s = h2.Columns("A").Find(h1.Cells(i, "A"))
    If Not s Is Nothing Then
        h1.Rows(i).Copy h3.Cells(j, 1) 'copia real
        h2.Rows(s.Row).Copy h3.Cells(j + 1, 1) 'copia real
        ucol1 = h3.Cells(j, Columns.Count).End(xlToLeft).Column
        ucol2 = h3.Cells(j + 1, Columns.Count).End(xlToLeft).Column
        ucolf = Application.Max(ucol1, ucol2)
        h3.Select
        h3.Range(Cells(j + 2, "B"), Cells(j + 2, ucolf)).Select
        Selection.FormulaR1C1 = "=R[-2]C-R[-1]C"
        j = j + 4
        h1.Rows(i).Delete Shift:=xlUp
        h2.Rows(s.Row).Delete Shift:=xlUp
    End If
    h1.Select
Next
Application.ScreenUpdating = True
h3.Select
MsgBox "Fin proceso: copiar filas iguales", vbInformation, "COPIAR"
End Sub

Saludos.Dam

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas