Sub QuitaRepes()
        
    Dim y As Integer
    Dim a As Variant
    Dim b As Variant
    Dim i As Integer
    Dim j As Integer
    
    For i = 0 To 2
        Range("B5").Select
        ActiveCell.Offset(0, i).Activate
        y = 0
        Do While Not IsEmpty(ActiveCell.Offset(y, 0))
            y = y + 1
        Loop
        ActiveCell.Offset(y - 1, 0).Activate
        For j = y To 1 Step -1
            a = ActiveCell.Value
            b = ActiveCell.Offset(-1, 0).Value
            If a = b Then
                Selection.ClearContents
            End If
            ActiveCell.Offset(-1, 0).Activate
        Next j
    Next i
    Range("A1").Select
End Sub