Macro para buscar nombre repetidos en libro

En una hoja hay una tabla con varios nombre de artículos y esos nombres se repiten en otras hojas 1 o más veces, pero aveces no se repiten.

Lo que deseo es que en la hoja1 (donde están todos los nombres) aplicar una macro que recorra toda la tabla nombre por nombre y si ese nombre se repite en cualquier otra hoja 1 o más veces me cambie el color (cualquiera) de la celda.

Esto lo hago con el sentido de depurar los no repetidos.

También puede ser una fórmula

1 respuesta

Respuesta
1

Te anexo la macro.

Cambia en la macro "Hoja1" y "A" por tus datos.

Sub Buscar_Nombres()
'Por Dante Amor
    '
    Set h1 = Sheets("Hoja1")    'hoja de nombres
    col = "A"                   'columna de nombres
    h1.Columns(col).Interior.ColorIndex = xlNone
    For i = 2 To h1.Range(col & Rows.Count).End(xlUp).Row
        If h1.Cells(i, col).Value <> "" Then
            For Each h In Sheets
                If h.Name <> h1.Name Then
                    Set b = h.Columns(col).Find(h1.Cells(i, col).Value, lookat:=xlWhole)
                    If Not b Is Nothing Then
                        h1.Cells(i, col).Interior.ColorIndex = 6
                    End If
                End If
            Next
        End If
    Next
    MsgBox "fin"
End Sub

'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 

Hola dante,

Ante todo gracias por responder, la macro funciona, solo que lo hace si los nombres están en la misma columna en todas las hojas, y el cual es mi caso porque en la hoja1 están en la columna B, pero en las demás pueden ser C,D o E.

Gracias de antemano

No especificaste las columnas en tu requerimiento original.

Te anexo la macro actualizada

Sub Buscar_Nombres()
'Por Dante Amor
    '
    Set h1 = Sheets("Hoja1")    'hoja de nombres
    col = "B"                   'columna de nombres
    h1.Columns(col).Interior.ColorIndex = xlNone
    For i = 2 To h1.Range(col & Rows.Count).End(xlUp).Row
        If h1.Cells(i, col).Value <> "" Then
            For Each h In Sheets
                If h.Name <> h1.Name Then
                    Set b = h.Columns("C:E").Find(h1.Cells(i, col).Value, lookat:=xlWhole)
                    If Not b Is Nothing Then
                        h1.Cells(i, col).Interior.ColorIndex = 6
                    End If
                End If
            Next
        End If
    Next
    MsgBox "fin"
End Sub

'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas