Macro para eliminar filas duplicadas tras ejecutar otra macro

Solicito y agradezco ayuda para revisar una función dentro de una macro:

Se trata de una macro que ejecute dos funciones: la primera, ya incluida, y que funciona correctamente es la de copiar filas desde una pestaña de introducción de datos a otra pestaña en función del cumplimiento de una condición (casilla que indica la hoja de destino de esa fila).

La segunda, que no consigo formular adecuadamente, es la de eliminar filas duplicadas de la hoja de destino cuando se detecte que se repite el valor de una celda que no es más que el nºde introducción del dato.

Esta segunda función es necesaria para evitar que cada vez que se activa la macro, se vuelvan a copiar redundantemente los datos escritos en la hoja de introducción a cada una de las hojas correspondientes, consecuencia de la primera función que cumple la macro.

He intentado formularla en base a otras preguntas, pero el resultado no es bueno ya que además de eliminar la redundacia parece que elimina una fila más de lo debido, el último dato introducido en la activación de macro anterior;

Agradezco ayuda, adjunto:

Parte de la macro que no da buen resultado: (lo que se quiere que haga es que revise la columna B, y que cada vez que detecte dos celdas con el mismo valor, elimine toda la fila de la segunda celda, no solo el contenido sino la fila al completo)

'Aquí comenzamos con la segunda parte de la macro, revisar y eliminar duplicación de datos
    H2.Select
        For i = 3 To H2.Range("B" & Rows.Count).End(xlUp).Row
        For j = 3 To H2.Range("B" & Rows.Count).End(xlUp).Row
            If H2.Cells(i, "B") = H2.Cells(j, "B") Then
                H2.Rows(j).Delete Shift:=xlUp
            Exit For
        End If
        Next
        Next

Imagen de la hoja de cálculo:

1

1 respuesta

Respuesta
1

Te anexo la macro actualizada

'Act. Por. Dante Amor
    h2.Select
    For i = 3 To h2.Range("B" & Rows.Count).End(xlUp).Row
        For j = h2.Range("B" & Rows.Count).End(xlUp).Row To i + 1 Step -1
            If h2.Cells(i, "B") = h2.Cells(j, "B") Then
                h2.Rows(j).Delete
            End If
        Next
    Next

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas