Erreur 1004 : la methode Paste de la classe Worksheet a échoué

Bonjour,

J'ai cette erreur (" Erreur 1004 : la methode Paste de la classe Worksheet a échoué ") qui s'affiche lorsque j'utilise cette macro :

Sub Clean()

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    activesheet.Unprotect "??"
    activesheet.Range("R18").Value = "/"
    activesheet.Range("R19").Value = "/"
    activesheet.Range("R12").Value = "/"
    activesheet.Range("R13").Value = "/"
    activesheet.Range("R6").Value = "/"
    activesheet.Range("R7").Value = "/"
    activesheet.Range("R4").Value = ""
    activesheet.Range("Supr.4").Value = "1"
    activesheet.Protect "??", True, True, True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Sauf que l'erreur ne s'affiche pas tjr, voir jamais...

J'ai souvent ce problème lorsque j'utilise la macro juste après avoir ouvert mon excel.

Pour information lorsque j'utilise ma macro ces macros qui s'active toute seul.

Private Sub Worksheet_Change(ByVal Target As Range)

        If Not Intersect(Target, activesheet.Range("R6")) Is Nothing Then
    If Range("R6") <> "/" Then
        activesheet.Range("Supr.1") = ""
        activesheet.Range("R7").Value = "a"
    End If
    End If

        If Not Intersect(Target, activesheet.Range("R6")) Is Nothing Then
    If Range("R6") = "/" Then
        activesheet.Range("Supr.1") = ""
        activesheet.Range("R7").Value = "/"
    End If
    End If

     If Not Intersect(Target, activesheet.Range("R12")) Is Nothing Then
    If Range("R12") <> "/" Then
        activesheet.Range("Supr.2") = ""
        activesheet.Range("R13").Value = "b"
    End If
    End If

         If Not Intersect(Target, activesheet.Range("R12")) Is Nothing Then
    If Range("R12") = "/" Then
        activesheet.Range("Supr.2") = ""
        activesheet.Range("R13").Value = "/"
    End If
    End If

     If Not Intersect(Target, activesheet.Range("R18")) Is Nothing Then
       If Range("R18") <> "/" Then
        activesheet.Range("Supr.3") = ""
        activesheet.Range("R19").Value = "c"
    End If
    End If

    If Not Intersect(Target, activesheet.Range("R18")) Is Nothing Then
       If Range("R18") = "/" Then
        activesheet.Range("Supr.3") = ""
        activesheet.Range("R19").Value = "/"
    End If
    End If

     If Not Intersect(Target, activesheet.Range("R2")) Is Nothing Then
        activesheet.Range("R4") = ""
        activesheet.Range("R3") = ""
    End If

 '--------------------------------------------------------------------

  If Target.Address = "$R$6" Then
      activesheet.Unprotect "??"
    '-- suppression
    For Each s In activesheet.Shapes
      If s.Type = 13 Then
        If s.TopLeftCell.Address = Target.Offset(0, -11).Address Then
          s.Delete
        End If
      End If
    Next s
    '--
    If Target <> "" Then
        Sheets("DONNEES").Shapes(Target).Copy
        Target.Offset(0, 2).Select
        activesheet.Activate
        activesheet.Paste
        Selection.ShapeRange.Left = ActiveCell.Left - 867
        Selection.ShapeRange.Top = ActiveCell.Top + 8
        Target.Select
     End If
     activesheet.Protect "??", True, True, True

  End If

Merci pour votre aide les experts de VBA!

Bonjour,

Tu as des instructions contradictoires en R6, R12 et R18.

Il faudra choisir soit l'une, soit l'autre.

ric

Salut,

C'est à dire?

Bonjour,

Regarde ton code, sur les trois cellules mentionnées, il y a deux instructions qui écrivent au même endoit ...

Exemple :

   If Not Intersect(Target, ActiveSheet.Range("R6")) Is Nothing Then
      If Range("R6") <> "/" Then
         ActiveSheet.Range("Supr.1") = ""
         ActiveSheet.Range("R7").Value = "a"
      End If
   End If

   If Not Intersect(Target, ActiveSheet.Range("R6")) Is Nothing Then
      If Range("R6") = "/" Then
         ActiveSheet.Range("Supr.1") = ""
         ActiveSheet.Range("R7").Value = "/"
      End If
   End If

ric

Merci pour ton commentaires, j'ai corrigé ca...On verra bien si j'ai encore le problème.

Merci