Trovare celle doppie ed eliminare celle in tabella.

Sub univoci()
Dim Rng As Range, Cel As Range, stg As String, n As Long
Set Rng = Range("B4:G100")
    For Each Cel In Rng
        If InStr(stg, Cel) = 0 Then
            stg = stg & Cel & ","
            If InStr(stg, Cel) > 0 Then
                'SUB INVIA MAIL()
                n = n + 1
            End If
        End If
    Next
    MsgBox "Inviate " & n & " mail "
Set Rng = Nothing
End Sub

Sub univoci2()
Dim R1 As Range, R2 As Range, R3 As Range, R4 As Range, R5 As Range, R6 As Range
Dim Rng As Range, Cel As Range, stg As String, n As Long
Set R1 = Range("B4:B100")
Set R2 = Range("D4:D100")
Set R3 = Range("F4:F100")
Set R4 = Range("H4:H100")
Set R5 = Range("J4:J100")
Set R6 = Range("L4:L100")
Set Rng = Uni0n(R1, R2, R3, R4, R5, R6) ' Attento il forum scrive Union con un zero al posto della o
    For Each Cel In Rng
        If InStr(stg, Cel.Value) = 0 Then
            stg = stg & Cel.Value & ","
            If InStr(stg, Cel.Value) > 0 Then
                'SUB INVIA MAIL()
                n = n + 1
            End If
        End If
    Next
    MsgBox "Inviate " & n & " mail "
Set R1 = Nothing
Set R2 = Nothing
Set R3 = Nothing
Set R4 = Nothing
Set R5 = Nothing
Set R6 = Nothing
Set Rng = Nothing
End Sub