Si la valeur d'une cellule est effacée, effacer d'autre cellules

Bonjour!

Petit problème, assez simple mais encore trop complexe pour moi. J'aurais besoin d'une macro événementielle pour Excel 2007.

Elle doit faire ceci:

À partir de la ligne 21, lorsque la valeur de la colonne G est effacée, je voudrais que les cellules K, M, N, O, P, Q et R de la même ligne soient aussi effacées.

Il y a déjà une macro événementielle sur mon fichier. Est-ce qu'il y a un problème à mettre plusieurs macros événementielles? Est-ce qu'il faut les combiner ou faire quelque chose de spécial pour que ça fonctionne? Excusez mes questions, je suis encore débutant.

Merci! :)

Bonjour,

Voici un essai (avec un petit doute sur range("K, M:R") ) :

private sub worksheet_change(byval target as range)
dim r as range
set r = intersect(target, columns(7))
if not r is nothing then
    for each cell in r.cells
        if cell.row > 20 then
            if cell.value = "" then range("K:K, M:R").rows(cell.row).clearcontents
        end if
    next cell
end if
end sub

Il n'y a qu'une seule macro par évènement. Pour l'évènement change, on peut décider que le comportement change en fonction de la zone ciblée par la modification.

Par exemple :

private sub worksheet_change(byval target as range)
if target.column = 1 then
    msgbox "modif en colonne A"
elseif target.column = 2 then
    msgbox "modif en colonne B"
else
    msgbox "modif ailleurs qu'en A ou B"
    target.interior.color = 255
end if
end sub

Cdlt,

Ça fonctionne très bien! Merci! Mais j'ai du effacer l'autre macro pour installer celle-ci. Je ne sais toujours pas comment on fait pour mettre deux macros en même temps. Il y a encore quelque chose que je ne comprend pas.

Voici mon autre macro événementielle, si ça peut être utile.

Option Explicit

Private Sub worksheet_change(ByVal target As Range)
If target.Column <> 7 Or target.Count > 1 Then Exit Sub
Dim chemin$, fichier$, feuille$, adr$, fich$, form$, i As Variant
chemin = "P:\TQCFGplay\registres_de_production\" 'à adapter
fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
feuille = "Feuil1" 'nom des feuilles sources, à adapter
If fichier = "" Then MsgBox "Aucun fichier .xls* trouvé...": Exit Sub
adr = target.Address(, , xlR1C1, True)
Do While fichier <> ""
    fich = Replace(fichier, "'", "''") 's'il y a une apostrophe dans le nom
    form = "'" & chemin & "[" & fich & "]" & feuille & "'!"
    i = ExecuteExcel4Macro("MATCH(" & adr & "," & form & "C9,0)") 'formule de liaison
    If IsNumeric(i) Then
        target(1, 12) = ExecuteExcel4Macro("INDEX(" & form & "C10," & i & ")") 'durée
        target(1, 5) = ExecuteExcel4Macro("INDEX(" & form & "C13," & i & ")") 'titre
        target(1, 7) = ExecuteExcel4Macro("INDEX(" & form & "C16," & i & ")") 'logo
        target(1, 8) = ExecuteExcel4Macro("INDEX(" & form & "C17," & i & ")") 'verset
        target(1, 9) = ExecuteExcel4Macro("INDEX(" & form & "C18," & i & ")") 'fonctions
        Exit Do 'on sort à la 1ère occurrence
    End If
    fichier = Dir 'fichier suivant
Loop
'If IsError(i) Then Union(Target(1, 0), Target(1, 2)) = "" 'RAZ

Range("H2").Copy target.Offset(0, -1)

End Sub

J'ai l'impression que je ne peux pas éditer mon dernier message. Désolé pour le double post.

Je commence à comprendre le problème. Si je comprends bien, les deux macros ne pourraient pas fonctionner puisqu'elles visent la même colonne. Je vais étudier la question et essayer de comprendre un peu mieux le fonctionnement des macros et je reviens demain.

Bonjour le fil

On peut tout à fait mettre plusieurs codes, voici ce que je ferais

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Chemin$, Fichier$, Feuille$, Adr$, Fich$, Form$, i As Variant
  '
  If Target.Column <> 7 Or Target.Count > 1 Then Exit Sub
  ' Si modification dans colonne 7 et ligne >= 21
  If Target.Value = "" And Target.Row >= 21 Then
    Application.EnableEvents = False
    ' Range("K:K, M:R").Rows(Target.Row).ClearContents = Ne fonctionne pas correctemnt !?
    Range("K" & Target.Row & ",M" & Target.Row & ":R" & Target.Row).ClearContents
    Application.EnableEvents = True
    Exit Sub  ' On sort de la procédure
  End If
  '
  Chemin = "P:\TQCFGplay\registres_de_production\" 'à adapter
  Fichier = Dir(Chemin & "*.xls*") '1er fichier du dossier
  Feuille = "Feuil1" 'nom des feuilles sources, à adapter
  If Fichier = "" Then MsgBox "Aucun fichier .xls* trouvé...": Exit Sub
  Adr = Target.Address(, , xlR1C1, True)
  Do While Fichier <> ""
      Fich = Replace(Fichier, "'", "''") 's'il y a une apostrophe dans le nom
      Form = "'" & Chemin & "[" & Fich & "]" & Feuille & "'!"
      i = ExecuteExcel4Macro("MATCH(" & Adr & "," & Form & "C9,0)") 'formule de liaison
      If IsNumeric(i) Then
          Target(1, 12) = ExecuteExcel4Macro("INDEX(" & Form & "C10," & i & ")") 'durée
          Target(1, 5) = ExecuteExcel4Macro("INDEX(" & Form & "C13," & i & ")") 'titre
          Target(1, 7) = ExecuteExcel4Macro("INDEX(" & Form & "C16," & i & ")") 'logo
          Target(1, 8) = ExecuteExcel4Macro("INDEX(" & Form & "C17," & i & ")") 'verset
          Target(1, 9) = ExecuteExcel4Macro("INDEX(" & Form & "C18," & i & ")") 'fonctions
          Exit Do 'on sort à la 1ère occurrence
      End If
      Fichier = Dir 'fichier suivant
  Loop
  Application.EnableEvents = False
  Range("H2").Copy Target.Offset(0, -1)
  Application.EnableEvents = True
End Sub

@+

Merci BrunoM45. Ça fonctionne! En plus, j'ai appris des choses! :D

Rechercher des sujets similaires à "valeur effacee effacer"