ついでに○の書いてある行を削除してみる。

けど、何度か実行しないと削除が完了しない。なんでだろう？

Sub DeleteRows()
    Dim RanA As Range

    For Each RanA In Range("TableA!B1:B7000")
        If RanA.Cells.Value <> "" Then
            If RanA.Cells.Value = "○" Then
                RanA.Cells.EntireRow.Delete
　　　　　　　　Exit For
            End If
        End If
    Next
    MsgBox ("Done!!!!")
End Sub

DeleteじゃなくてClearContentsつかえばいいだけじゃん

Sub DeleteRows()
    Dim RanA As Range

    For Each RanA In Range("TableA!B1:B7000")
        If RanA.Cells.Value <> "" Then
            If RanA.Cells.Value = "○" Then
                RanA.Cells.ClearContents
　　　　　　　　Exit For
            End If
        End If
    Next
    MsgBox ("Done!!!!")
End Sub