Error en macro formato condicional

Hola a todos! Gracias a este grupo de discusión he encontrado multitud de
herramientas que me han ayudado muchísimo en mi trabajo. Hace unos días
hice
una macro para insertar formato condicional con 5 condiciones (basándome
en
las hay publicadas aquí) y tengo un problema cuando quiero insertar o
pegar
nuevas filas.

El error que sale es el siguiente:

"Se ha producido el error '13' en tiempo de ejecución.
No coinciden los tipos"

La macro que da estos problemas es la siguiente:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("F2:F6000")) Is Nothing Then _
Exit Sub
With Target.Font
Select Case Target
Case "Muy alta"
.ColorIndex = 9
Case "Alta"
.ColorIndex = 3
Case "Media"
.ColorIndex = 45
Case "Baja"
.ColorIndex = 36
Case Else
.ColorIndex = 0
End Select
With Target.Interior
Select Case Target
Case "Muy alta"
.ColorIndex = 9
Case "Alta"
.ColorIndex = 3
Case "Media"
.ColorIndex = 45
Case "Baja"
.ColorIndex = 36
Case Else
.ColorIndex = 0
End Select
End With
End With
End Sub

Quería saber si alguien podrías darme una solución. Muchas gracias de
antemano a todos!!

Ocurre porque el rango de Target NO contiene UNA SOLA celda.

De las siguientes añade la segunda linea a tu código:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("F2:F6000")) Is Nothing Then _
Exit Sub

Saludos desde Tenerife.
********************************
"Alfinga" escribió en el mensaje
news:
> Hola a todos! Gracias a este grupo de discusión he encontrado multitud de
> herramientas que me han ayudado muchísimo en mi trabajo. Hace unos días
> hice
> una macro para insertar formato condicional con 5 condiciones (basándome
> en
> las hay publicadas aquí) y tengo un problema cuando quiero insertar o
> pegar
> nuevas filas.
>
> El error que sale es el siguiente:
>
> "Se ha producido el error '13' en tiempo de ejecución.
> No coinciden los tipos"
>
> La macro que da estos problemas es la siguiente:
>
> Private Sub Worksheet_Change(ByVal Target As Range)
> If Intersect(Target, Range("F2:F6000")) Is Nothing Then _
> Exit Sub
> With Target.Font
> Select Case Target
> Case "Muy alta"
> .ColorIndex = 9
> Case "Alta"
> .ColorIndex = 3
> Case "Media"
> .ColorIndex = 45
> Case "Baja"
> .ColorIndex = 36
> Case Else
> .ColorIndex = 0
> End Select
> With Target.Interior
> Select Case Target
> Case "Muy alta"
> .ColorIndex = 9
> Case "Alta"
> .ColorIndex = 3
> Case "Media"
> .ColorIndex = 45
> Case "Baja"
> .ColorIndex = 36
> Case Else
> .ColorIndex = 0
> End Select
> End With
> End With
> End Sub
>
> Quería saber si alguien podrías darme una solución. Muchas gracias de
> antemano a todos!!