Consolidar datos de dos hojas en una hoja nueva

Tengo dos hoja con datos, necesito compararlas y hacer un consolidado en una hoja nueva, pero no se como hacerlo.

Solicito ayuda urgente

2 respuestas

Respuesta
1

H o l a:

En un correo nuevo envíame tu archivo y me explicas con ejemplos lo que necesitas.

Ya te envié el correo.

Gracias.

Te anexo la macro

Sub ConsolidarDatos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.StatusBar = False
    Set h1 = Sheets("PLANILLA ASISTENCIA")
    Set h2 = Sheets("BIOMETRICO ASISTENCIA")
    Set h3 = Sheets("CONSOLIDADO")
    h3.Range("A4:AJ" & h3.Range("A" & Rows.Count).End(xlUp).Row + 4).ClearContents
    'Compara 1 con 2 y actualiza 3
    u = h1.Range("D" & Rows.Count).End(xlUp).Row
    For i = 4 To u
        Application.StatusBar = "Procesando Hoja1, Registro: " & i & " de " & u
        'copia el registro de 1 a 3
        u3 = h3.Range("D" & Rows.Count).End(xlUp).Row + 1
        h1.Range("A" & i & ":AJ" & i).Copy h3.Range("A" & u3)
        '
        existe = False
        Set r = h2.Columns("D")                             'busca por id trabajador
        Set b = r.Find(h1.Cells(i, "D"), lookat:=xlWhole)
        If Not b Is Nothing Then
            celda = b.Address
            Do
                'detalle
                If h2.Cells(b.Row, "A") = h1.Cells(i, "A") And _
                   h2.Cells(b.Row, "B") = h1.Cells(i, "B") Then
                    existe = True
                    fila = b.Row
                    'iguala columnas
                    For j = Columns("E").Column To Columns("AI").Column
                        If h2.Cells(b.Row, j) = 1 Then
                            h3.Cells(u3, j) = 1
                        End If
                    Next
                    Exit Do
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        End If
    Next
    '
    'Compara 2 con 1 y actualiza 3
    u = h2.Range("D" & Rows.Count).End(xlUp).Row
    For i = 4 To u
        Application.StatusBar = "Procesando Hoja2, Registro: " & i & " de " & u
        existe = False
        Set r = h1.Columns("D")                             'busca por ID trabajador
        Set b = r.Find(h2.Cells(i, "D"), lookat:=xlWhole)   '
        If Not b Is Nothing Then
            celda = b.Address
            Do
                'detalle
                If h1.Cells(b.Row, "A") = h2.Cells(i, "A") And _
                   h1.Cells(b.Row, "B") = h2.Cells(i, "B") Then
                    existe = True
                    Exit Do
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        End If
        If existe = False Then
            'copia el registro de 2 a 3
            u3 = h3.Range("D" & Rows.Count).End(xlUp).Row + 1
            h2.Range("A" & i & ":AJ" & i).Copy h3.Range("A" & u3)
        End If
    Next
    '
    u = h3.Range("D" & Rows.Count).End(xlUp).Row
    With h3.Sort
        .SortFields.Clear: .SortFields.Add Key:=h3.Range("A4:A" & u)
                           .SortFields.Add Key:=h3.Range("B4:B" & u)
                           .SortFields.Add Key:=h3.Range("D4:D" & u)
        .SetRange h3.Range("A3:AJ" & u): .Header = xlYes: .Apply
    End With
    '
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "fin"
End Sub

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Respuesta
1

Si quieres comparar celda a celda puedes usar esto:

=SI(Hoja2!A1="";SI(Hoja3!A1="";"";Hoja3!A1);Hoja2!A1)

El problema lo tienes si hay datos en las dos celdas, puesto que la fórmula te devolverá el valor de la primera hoja en la que mira (Hoja2). Si siempre que se dé el caso ya te va bien que sea así, esto te sirve. Caso contrario habría que darle una vuelta según lo que quieras.

Si los datos están organizados de forma lógica como base de datos con registros que se pueden identificar con el valor de un campo tipo ID, entonces la cosa cambia. Ya respondí a un problema así hace unos días:

@¿Macro para realizar BuscarV dependiendo de los titulos?

La cuestión es que quiero comparar dos hojas que en teoría deberían tener los mismos registros, es decir, ser iguales, la cuestión es que una tiene mas registros que la otra. La idea es que compare las dos hojas 1 y 2, y en hoja 3 me copie lo de las dos hojas sin duplicados.

La macro que tengo me compara las dos hojas, primero compara la hoja 1 con la dos y en la hoja 1 me copia lo que tenia diferente con hoja2, luego compara la hoja 2 con la 1 y en la hoja 2 me copia lo que le faltaba de la hoja 1 quedando las dos hojas exactamente iguales.

Solo que ahora no puedo modificar las hojas 1 y 2, esas comparaciones necesito que me las arroje a hoja3 como consolidado.

No se si me hice entender.

No termino de entender. Por lo que dices comparas celda a celda primando los datos de la hoja 2 en caso que en ambas haya datos. Entonces la solución sería algo así:

=SI(Hoja2!A1="";SI(Hoja1!A1="";"";Hoja1!A1);Hoja2!A1)

Y arrastras hasta donde quieras.

La otra opción sería una macro.

Si, eso lo estoy manejando con una macro.

¿Puedes pegar tu código?

Private Sub BtnIgualar_Click()
    Application.ScreenUpdating = False
    Application.StatusBar = False
    Set h1 = Sheets("PLANILLA ASISTENCIA")
    Set h2 = Sheets("BIOMETRICO ASISTENCIA")
    '
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    If h2.AutoFilterMode Then h2.AutoFilterMode = False
    'Compara 1 con 2 y actualiza 2
    u = h1.Range("D" & Rows.Count).End(xlUp).Row
    For i = 2 To u
        Application.StatusBar = "Procesando Hoja1, Registro: " & i & " de " & u
        existe = False
        Set r = h2.Columns("C")                             'nombre hoja2 "D"
        Set b = r.Find(h1.Cells(i, "D"), lookat:=xlWhole)   'nombre hoja1 "E"
        If Not b Is Nothing Then
            celda = b.Address
            Do
                'detalle
                If h2.Cells(b.Row, "A") = h1.Cells(i, "B") And _
                   h2.Cells(b.Row, "B") = h1.Cells(i, "C") Then
                    existe = True
                    'iguala columnas
                    For j = Columns("G").Column To Columns("AJ").Column
                        If h1.Cells(i, j) <> h2.Cells(b.Row, j - 2) Then
                            If h1.Cells(i, j) = 1 Then
                                h2.Cells(b.Row, j - 2) = 1
                            Else
                                h1.Cells(i, j) = 1
                            End If
                        End If
                    Next
                    Exit Do
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        End If
        If existe = False Then
            u2 = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
            h1.Range("B" & i & ":E" & i).Copy h2.Range("A" & u2)
            h1.Range("G" & i & ":AK" & i).Copy h2.Range("E" & u2)
        End If
    Next
    '
    'Compara 2 con 1 y actualiza 1
    u = h2.Range("D" & Rows.Count).End(xlUp).Row
    For i = 2 To u
        Application.StatusBar = "Procesando Hoja2, Registro: " & i & " de " & u
        existe = False
        Set r = h1.Columns("D")                             'nombre hoj1
        Set b = r.Find(h2.Cells(i, "C"), lookat:=xlWhole)   'nombre hoja2
        If Not b Is Nothing Then
            celda = b.Address
            Do
                'detalle
                If h1.Cells(b.Row, "B") = h2.Cells(i, "A") And _
                   h1.Cells(b.Row, "C") = h2.Cells(i, "B") Then
                    existe = True
                    Exit Do
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        End If
        If existe = False Then
            u1 = h1.Range("B" & Rows.Count).End(xlUp).Row + 1
            h2.Range("A" & i & ":D" & i).Copy h1.Range("B" & u1)
            h2.Range("E" & i & ":AI" & i).Copy h1.Range("G" & u1)
        End If
    Next
    '
    u = h1.Range("D" & Rows.Count).End(xlUp).Row
    With h1.Sort
        .SortFields.Clear: .SortFields.Add Key:=h1.Range("B4:B" & u)
                           .SortFields.Add Key:=h1.Range("C4:C" & u)
                           .SortFields.Add Key:=h1.Range("D4:D" & u)
        .SetRange h1.Range("A3:AK" & u): .Header = xlYes: .Apply
    End With
    '
    u = h2.Range("D" & Rows.Count).End(xlUp).Row
    With h2.Sort
        .SortFields.Clear: .SortFields.Add Key:=h1.Range("A2:A" & u)
                           .SortFields.Add Key:=h1.Range("B2:B" & u)
                           .SortFields.Add Key:=h1.Range("C2:C" & u)
        .SetRange h1.Range("A1:AI" & u): .Header = xlYes: .Apply
    End With
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "Fin"
End Sub

Mañana lo miro. Mientras tanto si algún experto lo resuelve pues genial.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas