Erreur 1004 'intersect

Bonjour,

Dans mon fichier ci-joint j'ai par moment un message d'erreur qui apparait : Erreur d'exécution 1004 : La méthode 'Intersect de l'objet_Application a échoué'.

Cela me surligne la dernière ligne de mon code en jaune :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ValSaisie As Variant
' Choix multiple en colonne B
If Left(Target.Address, 2) = "$B" And Target.Count = 1 Then
ValSaisie = Target
Application.EnableEvents = False
If ValSaisie = "" Then
Target.ClearContents
GoTo FinProc
End If
Application.Undo
p = InStr(Target, ValSaisie)
If p > 0 Then
Target = Left(Target, p - 1) & Mid(Target, p + Len(ValSaisie) + 1)
If Right(Target, 1) = Chr(10) Then
Target = Left(Target, Len(Target) - 1)
End If
Else
If Target = "" Then
Target = ValSaisie
Else
Target = Target & Chr(10) & ValSaisie
End If
End If
FinProc:
Application.EnableEvents = True
End If

' teste si la cellule juste au dessus est remplie
If Range("premiereCelluleApresTableau").Offset(-1) <> "" Then
' ajoute une ligne - la ligne s'insère au dessus
Application.EnableEvents = False
Range("premiereCelluleApresTableau").EntireRow.Insert xlShiftDown
Application.EnableEvents = True
End If
If Not Application.Intersect(Target, ActiveSheet.ListObjects(1).ListColumns(1).DataBodyRange) Is Nothing Then Target.Offset(, 1) = ""
End Sub

Comment puis je m'en sortir car je ne comprends pas comment gérer cette erreur

? Merci !

Bonjour,

If Not Application.Intersect(Target, ActiveSheet.ListObjects(1).ListColumns(1).DataBodyRange) Is Nothing Then 

Bonjour,

Quel est clairement l'objectif de la procédure ? Ton code est imbuvable. !

Cdlt.

Bonjour Jean Eric,

L'idée est d'insérer automatiquement une ligne

Et de vider la B2 si on change le choix dans A1...