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 Respuesta
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 SubSaludos.Dam
