Worksheet-change

Bonjour, la macro ci-dessous s'execute bien quand je la lance manuellement, mais quand elle est associée à Private Sub worksheet_Change(ByVal Target As Range) rien ne se passe. Savez-vous pourquoi ?

Sub essai()

Dim plage As Range 'Plage de toutes les lignes et colonne du tableau A11:A...
Dim r As Range 'Représente la ligne parcourue du tableau
With ActiveSheet
       Set plage = .Range("D93:Y" & .Range("D" & Rows.Count).End(xlUp).Row)
    For Each r In plage.Rows 'Pour chaque ligne de la plage

        If r.Cells(1, 2).Value = "Sous-total" Then 'si la cellule de la deuxième colonne = sous-total
            r.Cells(1, 3) = "Sous-total " & Application.VLookup(r.Cells(1, 1).Value, .Range("i22:r50"), 3, False)  
      Else
      If r.Cells(1, 2).Value <> "Sous-total" And r.Cells(1, 3) Like "*Sous-total*" Then
      r.Cells(1, 3).Select
      Selection.ClearContents
      End If
    End If
    Next r
    End With

End Sub

Merci

Bonjour Jahman, bonjour le forum,

Essaie comme ça :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range 'Plage de toutes les lignes et colonne du tableau A11:A...
Dim r As Range 'Représente la ligne parcourue du tableau

Set plage = Range("D93:Y" & Range("D" & Rows.Count).End(xlUp).Row)

'pour éviter que la macro soit lancée systématiquement à chaque changement dans l'onglet (à adapter)
If Application.Intersect(Target, plage) Is Nothing Then Exit Sub 'limite l'action de la macro au changement uniquement dans la plage [plage]

For Each r In plage.Rows 'Pour chaque ligne de la plage
    If r.Cells(1, 2).Value = "Sous-total" Then 'si la cellule de la deuxième colonne = sous-total
        r.Cells(1, 3) = "Sous-total " & Application.VLookup(r.Cells(1, 1).Value, Range("i22:r50"), 3, False)  'mettre la date du jour dans la neuvième colonne
    Else
        If r.Cells(1, 2).Value <> "Sous-total" And r.Cells(1, 3) Like "*Sous-total*" Then
            r.Cells(1, 3).ClearContents
        End If
    End If
Next r
End Sub

Salut ThauThème, et merci.

Cela ne marche pas, Tu as rajouté un "if" donc j'ai essayé "End if" à plusieurs endroit mais soit erreur de compilation soit rien ne se passe.


Re,

J'ai scrupuleusement recopié ton code, en enlevant "With" et les points devant Range, sans rajouter de "End if".

Et.... ca marche.... à moitié... il s’exécute bien sauf qu'il me surligne la ligne de la recherchev :

r.Cells(1, 3) = "Sous-total " & Application.VLookup(r.Cells(1, 1).Value, Range("i22:r50"), 3, False)

alors que celle ci s'est bien exécutée.

capture

Re,

Sans le fichier qui va bien, difficile de t'en dire plus...

J'ai trouvé la solution.

Il suffisait de mettre "Application.EnableEvents"

Private Sub worksheet_Change(ByVal Target As Range)

Dim plage As Range 'Plage de toutes les lignes et colonne du tableau A11:A...
Dim r As Range 'Représente la ligne parcourue du tableau
With ActiveSheet
Application.EnableEvents = False

       Set plage = .Range("D93:AB" & .Range("D" & Rows.Count).End(xlUp).Row)
    For Each r In plage.Rows 'Pour chaque ligne de la plage

        If r.Cells(1, 2).Value = "Sous-total" Then 'si la cellule de la deuxième colonne = sous-total
            r.Cells(1, 3) = "Sous-total " & r.Cells(1, 25)  'mettre la date du jour dans la neuvième colonne
      Else
      If r.Cells(1, 2).Value <> "Sous-total" And r.Cells(1, 3) Like "*Sous-total*" Then
      r.Cells(1, 3).Select
      Selection.ClearContents
      End If
    End If
    Next r
    Application.EnableEvents = True

End With
End Sub

Re,

Oui bien vu Jahman ! Je n'y avais pas pensé pourtant c'est tellement évident...

Rechercher des sujets similaires à "worksheet change"