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