Sub VerificarDuplicados()
    Dim UltimaLinha As Long
    Dim Coluna As Range
    Dim Celula As Range
    Dim Duplicados As Collection
    
    ' Define a coluna que você quer verificar (exemplo: coluna A)
    Set Coluna = ThisWorkbook.Sheets("Planilha1").Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    
    ' Cria uma coleção para armazenar os valores únicos
    Set Duplicados = New Collection
    
    On Error Resume Next
    For Each Celula In Coluna
        ' Tenta adicionar o valor à coleção
        Duplicados.Add Celula.Value, CStr(Celula.Value)
        
        ' Se o valor já existir na coleção, ele será duplicado
        If Err.Number <> 0 Then
            ' Destaque as células duplicadas
            Celula.Interior.Color = vbYellow
            Err.Clear
        End If
    Next Celula
    On Error GoTo 0
End Sub