Erreur d'excution 13 VBA
Bonjour,
J'ai recopié ce code pour obtenir des listes déroulantes conditionnelles les unes aux autres sur plusieurs lignes mais lorsque que je tente de faire dérouler la case afin de la copier j'ai l'erreur d'exécution qui apparait, de même si je selectionne le tableau pour le vider...
Pouvez vous m'aider à corriger cela ?
Merci de votre aide
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B12:B60")) Is Nothing Then
Set d1 = CreateObject("Scripting.Dictionary")
For Each c In [produitvba]: d1(c.Value) = "": Next c
For Each c In d1.keys: temp = temp & c & ",": Next c
Target.Validation.Delete
Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
End If
'-- niv 2
If Not Application.Intersect(Target, Range("C12:C60")) Is Nothing Then
Set d1 = CreateObject("Scripting.Dictionary")
For Each c In [parementvba]
If c.Offset(0, -1) = Target.Offset(0, -1) Then d1(c.Value) = ""
Next c
If d1.Count > 0 Then
For Each c In d1.keys: temp = temp & c & ",": Next c
Target.Validation.Delete
Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
End If
End If
'---niv3
If Not Application.Intersect(Target, Range("D12:D60")) Is Nothing Then
Set d1 = CreateObject("Scripting.Dictionary")
For Each c In [finitionvba]
If c.Offset(0, -2) = Target.Offset(0, -2) And _
c.Offset(0, -1) = Target.Offset(0, -1) Then d1(c.Value) = ""
Next c
If d1.Count > 0 Then
For Each c In d1.keys: temp = temp & c & ",": Next c
Target.Validation.Delete
Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
End If
End If
'--- niv 4
If Not Application.Intersect(Target, Range("E12:E60")) Is Nothing Then
Set d1 = CreateObject("Scripting.Dictionary")
For Each c In [Epaisseur_isolvba]
If c.Offset(0, -3) = Target.Offset(0, -3) And _
c.Offset(0, -2) = Target.Offset(0, -2) And _
c.Offset(0, -1) = Target.Offset(0, -1) Then d1(c.Value) = ""
Next c
If d1.Count > 0 Then
For Each c In d1.keys: temp = temp & c & ",": Next c
Target.Validation.Delete
Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
End If
End If
'--- niv 5
If Not Application.Intersect(Target, Range("F12:F60")) Is Nothing Then
Set d1 = CreateObject("Scripting.Dictionary")
For Each c In [Epaisseur_chevronvba]
If c.Value <> "" Then
If c.Offset(0, -4) = Target.Offset(0, -4) And _
c.Offset(0, -3) = Target.Offset(0, -3) And _
c.Offset(0, -2) = Target.Offset(0, -2) And _
c.Offset(0, -1) = Target.Offset(0, -1) Then d1(c.Value) = ""
End If
Next c
If d1.Count > 0 Then
For Each c In d1.keys: temp = temp & c & ",": Next c
Target.Validation.Delete
Target.Validation.Add xlValidateList, Formula1:=Left(temp, Len(temp) - 1)
Else
MsgBox "pb:pas de hauteur"
Target.Validation.Delete
End If
End If
End Sub