Erreur d'excécution 13

[Hell Wheel]

Bonjour, mon fichier Excel m'affiche une Erreur d'exécution 13 lorsque je fais une insertion de ligne ou un copier glissé.

Pouvez-vous m'aider et m'expliquer cette erreur?

Merci à vous.

Voici le code VBA de mon fichier Excel.


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [D13:AQ48]) Is Nothing Then 'Selectionne la plaque des cellules dans laquelle la macro va se faire
Select Case Target.FormulaR1C1 ' <= la valeur dans la cellule
Case Is = "C", "c" ' <= si la valeur C
Target.Interior.Color = 65535
Target.Font.Color = 65535
Case Is = "T", "t" ' <= si la valeur T
Target.Interior.Color = 15773696
Target.Font.Color = 15773696
Case Is = "R", "r" ' <= si la valeur R
Target.Interior.Color = 5296274
Target.Font.Color = 5296274
Case Is = "F", "f" ' <= si la valeur F
Target.Interior.Color = 6697881
Target.Font.Color = 6697881
Case Is = "A", "a" ' <= si la valeur A
Target.Interior.Color = 9868950
Case Is = "TT", "tt" ' <= si la valeur TT
Target.Interior.Color = 12632256
Case Is = "E", "e" ' <= si la valeur E
Target.Interior.Color = 39423
Case Is = "1/2R", "1/2r", "1/2 R", "1/2 r" ' <= si la valeur 1/2 R
Target.Interior.Color = 5296274
Target.Font.Color = 16777215
Case Is = "1/2C", "1/2c", "1/2 C", "1/2 c" ' <= si la valeur 1/2 C
Target.Interior.Color = 65535
Case Is = "1/2RC", "1/2CR", "1/2rc", "1/2cr" ' <= si la valeur 1/2 RC
Target.Interior.Color = 5296274

Case Else ' <= si la valeur n'est égale à aucune des valeurs ci-dessus
Target.Interior.ThemeColor = xlThemeColorDark1
Target.Font.Color = 0
End Select
End If

End Sub

 

[Dranreb]

Bonjour.
L'erreur vient de ce que si plusieurs cellules sont changées en même temps, la Value de Target qui les représente est un tableau de Variant, lequel ne saurait être comparé à des valeurs élémentaires
Ajoutez une 1ère instruction If Target.CountLarge <> 1 Then Exit Sub

 

[Hell Wheel]

Ca marche parfaitement. Merci à vous pour votre aide