Al escribir en una celda ma valla dos espacios a la derecha

Buenas tardes

Necesitaría agregar a esta marco:

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' AGREGAR FECHA EN UNA COLUMNA
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
If Target.Column = 3 Then
If Cells(Target.Row, "D") = "" Then
ActiveSheet.Unprotect Password:="1"
Cells(Target.Row, "D") = Date
ActiveSheet.Protect Password:="1"
End If
End If
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' Columnas en MAYUSCULAS
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
If Not Application.Intersect(Target, Range("C1:C2000")) Is Nothing Then
ActiveSheet.Unprotect Password:="1"
Target.Value = UCase(Target)
ActiveSheet.Protect Password:="1"
End If
End Sub

Que cuando escriba en Range("C1:C2000") me salte en la misma celda pero en la columna "E"

Un saludo