入力を終えたセル内の特定の文字列の数を増やしたい

やりたいことは以下の通りです。

　①対象セル群のうち一つに文字列を入力し、下キーまたはTabキーで移動する
　②その際、セルの文字列のうち、特定の文字をReplace関数で１個から２個に増やす
　　※対象セル群はD列の２行目以下全てを対象とする

上記内容は下記コードで概ね実現出来たのですが、問題が残っております。

　①やや冗長に感じる
　②範囲指定がうまくいっていない
　　・D列セルから下に移動した時にコードが実行されない。
　　・なぜかE列では下移動時のコードが実行される。
　　　ただ、セルが二度目にアクティブになった時に実行される。
　　　しかし、E列では右移動時コードは実行されない。

以上、どなたかアドバイスを頂けないでしょうか。
何卒よろしくお願いいたします。

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)


    '①アクティブセルの一つ左のセル(LeftCell)の内容を操作する。
    Dim LeftCell As Range, i As Long, kazA As Long
    Set LeftCell = ActiveCell.Previous

    '②アクティブセルの一つ上のセル(UperCell)の内容を操作する。
    Dim UperCell As Range, ii As Long, kazB As Long
    Set UperCell = ActiveCell.Offset(-1, 0)

         'LeftCell内の、２個にしたい文字をカウントする
         For i = 1 To Len(LeftCell)

             If Mid(LeftCell, i, 1) = "＠" Then kazA = kazA + 1

        Next i


        'UperCell内の、２個にしたい文字をカウントする
        For ii = 1 To Len(UperCell)

             If Mid(UperCell, ii, 1) = "＠" Then kazB = kazB + 1

        Next ii


      'D列の２行目以下の範囲で、
        If ActiveCell.row >= 2 And _
           ActiveCell.Column = 5 Then


                '文字のカウントの結果が１個だけであり、LeftCellがアクティブでなくなったら
                If kazA = 1 And LeftCell <> ActiveCell.Previous.Address Then

                    'LeftCell内の１個の文字を２個に置き換える
                    LeftCell = Replace(LeftCell, "＠", "＠＠")

                'または、文字のカウントの結果が１個だけでありUperCellがアクティブでなくなったら
                ElseIf kazB = 1 And UperCell <> ActiveCell.Previous.Address Then

                    'UperCell内の１個の文字を２個に置き換える
                    UperCell = Replace(UperCell, "＠", "＠＠")

            End If

        End If

    End Sub