Code VBA pour effacer le contenu de cellules selon critère d'une autre feuille

tamatave33

XLDnaute Junior
Bonsoir le forum,

Je n'ai pas beaucoup de connaissances en VBA et je suis face à un petit problème, dont je ne trouve pas la solution dans d'autres discussions ayant déjà traité ce problème.

J'ai un classeur composé de plusieurs feuilles. Le contenu de la cellule (D10) de la feuil1 est soit "Oui", soit "Non".

Si (D10) = "Oui" je voudrais que le contenu des cellules (F60:F73), (G60:G73), (H60:H73), (F81:F105), (G81:G105), (H81:H105), (I81:I105), de la feuil2, soit effacé. La feuille 2 sera protégée sans mot de passe.

Par défaut (D10) = "Non" et dans ce cas des formules sont écrites dans les cellules citées ci-dessus.

Ci-joint un fichier pour exemple.

D'autre part, est-il possible si (D10) = "Oui" et donc que le contenu des cellules citées plus haut est effacé de revenir à la position par défaut ?

Merci d'avance pour votre aide.
 

Pièces jointes

  • Exemple.xls
    28 KB · Affichages: 59
  • Exemple.xls
    28 KB · Affichages: 64

mutzik

XLDnaute Barbatruc
Re : Code VBA pour effacer le contenu de cellules selon critère d'une autre feuille

bonjour

if sheets("Feuil1").range("D10") = "Oui" then
with sheets("Feuil2")
.range("F60:F73").clearcontents
.range ...
end with
end if

c'est l'idée
 

Papou-net

XLDnaute Barbatruc
Re : Code VBA pour effacer le contenu de cellules selon critère d'une autre feuille

Bonsoir tamatave33,

Macro à insérer dans le module Feuil1.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$10" And Target = "Oui" Then
  With Feuil2
    .Unprotect
    .Range("F60:H73,F81:I105").ClearContents
    .Protect
  End With
End If
End Sub
Cordialement.

Oups, bonsoir Bertrand.
 

tamatave33

XLDnaute Junior
Re : Code VBA pour effacer le contenu de cellules selon critère d'une autre feuille

Bonjour Bertrand et Papou-net, bonjour le forum,

Merci pour votre aide.
Pour revenir à l'état initial lorsque les cellules (F60:H73, F81:I105) sont vides, j'ai pensé à la solution suivante :
- je fais une copie de ces cellules en (K60:M73, K81:N105) de la feuil2, quelle que soit la valeur de la cellule D10 de la feuil1
- je teste si les cellules H60 et I81 sont vides (si ces cellules sont vides, les autres cellules (F60:H73) et (F81:I105) le seront obligatoirement),
- je copie les cellules (K60:M73, K81:N105), que je colle en (F60:H73, F81:I105).
J'ai écrit un code en ce sens, en m’inspirant de votre réponse, mais il ne marche pas.
Pouvez-vous m'aider ?
Merci d'avance
 

Pièces jointes

  • Exemple modifié.xls
    38.5 KB · Affichages: 51

Papou-net

XLDnaute Barbatruc
Re : Code VBA pour effacer le contenu de cellules selon critère d'une autre feuille

Bonjour tamatave33,

Comme ça, à première vue, le problème viendrait de tes instructions "Application.CutCopyMode = False". elles vident le presse-papiers avant de coller le résultat.

Essaie comme ceci:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$10" And Target = "Oui" Then
  With Feuil2
    Unprotect
    Range("F60:H73,F81:I105").ClearContents
    'Protect
  End With
End If
If Target.Address = "$D$10" And Target = "Non" Then
  With Feuil2
    Unprotect
    If Range("H60,H81") = 0 Then
        Range("K60:M73").Copy
        Range("F60").Select
        ActiveSheet.Paste
        Range("K82:N105").Copy
        Range("F81").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
    End If
    'Protect
  End With
End If
End Sub
Cordialement.
 

tamatave33

XLDnaute Junior
Re : Code VBA pour effacer le contenu de cellules selon critère d'une autre feuille

Bonjour Papou-net,
Merci pour ta réponse très rapide.
J'ai recopié ton code, mais ça ne marche pas, ça bloque à la ligne "If Target.Address = "$D$10" And Target = "Oui" Then"
et j'ai le message suivant : "Erreur d'exécution '13' : Incompatibilité de type".
Si tu as une idée ?
Merci encore.
 

Papou-net

XLDnaute Barbatruc
Re : Code VBA pour effacer le contenu de cellules selon critère d'une autre feuille

RE:

Voici ton code revisité, avec copie en PJ pour vérification.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$10" Then
  With Feuil2
    .Unprotect
    Select Case UCase(Range("D10"))
      Case "OUI"
        .Range("F60:H73,F81:I105").ClearContents
      Case "NON"
        If .Range("H60,H81") = 0 Then
          .Range("K60:M73").Copy .Range("F60")
          .Range("K82:N105").Copy .Range("F81")
          Application.CutCopyMode = False
        End If
    End Select
    .Protect
  End With
End If
End Sub
Tu remarqueras que j'ai supprimé les "Select" qui ne sont pas indispensables pour agir sur des feuilles/cellules, d'autant qu'ils freinent le déroulement.

Cordialement.
 

Pièces jointes

  • Copie de Exemple modifié.xls
    46.5 KB · Affichages: 53

tamatave33

XLDnaute Junior
Re : Code VBA pour effacer le contenu de cellules selon critère d'une autre feuille

Bonsoir Papou-net, bonsoir le forum,

J'aurais besoin encore de ton aide. J'ai repris le code que tu m'avais donné et je l'ai appliqué à une autre feuille, c'est à dire qu'en fonction de la valeur de la cellule D10, je veux effacer ou copier des cellules de la Feuil2 et de la Feuil16, mais j'ai un message d'erreur.
Code que j'ai écris :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$10" Then
  With Feuil2
    .Unprotect
    Select Case UCase(Range("D10"))
      Case "OUI"
        .Range("F60:H73,F81:I105").ClearContents
        '.Protect

      Case "NON"
        If .Range("H60,H81") = 0 Then
          .Range("K60:M73").Copy .Range("F60")
          .Range("K82:N105").Copy .Range("F81")
          Application.CutCopyMode = False
          '.Protect
        End If
With Feuil16
    .Unprotect
    Select Case UCase(Range("D10"))
      Case "OUI"
        .Range("C15:G39,H43:H57,E61:E85,G61:L85").ClearContents
        '.Protect
      Case "NON"
          .Range("Q15:U39").Copy .Range("C15")
          .Range("S43:S57").Copy .Range("H43")
          .Range("R61:R85").Copy .Range("E61")
          .Range("S61:X85").Copy .Range("G61")
          .Application.CutCopyMode = False
          '.Protect
    
    End Select
  End With
End If
End Sub

Merci d'avance pour votre aide.
 

Pièces jointes

  • Exemple modifié (1).xls
    55 KB · Affichages: 51

Papou-net

XLDnaute Barbatruc
Re : Code VBA pour effacer le contenu de cellules selon critère d'une autre feuille

Bonsoir tamatave,

Je te conseillerai de prendre l'habitude de respecter la hiérarchies des tabulations dans ton code afin d'en faciliter la relecture. Les erreurs provenaient des End If, End Select et autres End Select, mal placés ou manquants.

Ton code "revisité":

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$10" Then
  With Feuil2
    .Unprotect
    Select Case UCase(Range("D10"))
      Case "OUI"
        .Range("F60:H73,F81:I105").ClearContents
      Case "NON"
        If .Range("H60,H81") = 0 Then
          .Range("K60:M73").Copy .Range("F60")
          .Range("K82:N105").Copy .Range("F81")
          Application.CutCopyMode = False
        End If
    End Select
    .Protect
  End With
  With Feuil16
    .Unprotect
    Select Case UCase(Range("D10"))
      Case "OUI"
        .Range("C15:G39,H43:H57,E61:E85,G61:L85").ClearContents
          '.Protect
      Case "NON"
          .Range("Q15:U39").Copy .Range("C15")
          .Range("S43:S57").Copy .Range("H43")
          .Range("R61:R85").Copy .Range("E61")
          .Range("S61:X85").Copy .Range("G61")
          .Application.CutCopyMode = False
    End Select
    .Protect
  End With
End If
End Sub
Cordialement.
 
Haut Bas