XL 2016 Private Sub ne fonctionne pas

MaNU84510

XLDnaute Nouveau
Bonjour à tous, j'espère que vous pourrez m'aider. J'ai essayer de créer un code qui me permet de lorsque vous modifiez une cellule dans la colonne A de la feuille de calcul actuelle, cette modification est enregistrée dans une autre feuille de calcul appelée "Suivi global". Si la feuille "Suivi global" n'existe pas, elle est créée.
Pourtant lorsque j'insère ce code dans un module il ne se passent rien. C'est comme si il n'existait pas dutout pour mon fichier.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim suiviGlobal As Worksheet
Dim lastRow As Long

' Nom de la feuille de calcul "Suivi global"
Const suiviGlobalSheetName As String = "Suivi global"

' Vérifie si la modification concerne la colonne A
If Not Intersect(Target, Me.Columns("A")) Is Nothing Then
' Désactive les événements pour éviter une boucle infinie
Application.EnableEvents = False

' Gestion des erreurs pour vérifier si la feuille "Suivi global" existe
On Error Resume Next
Set suiviGlobal = Worksheets(suiviGlobalSheetName)
On Error GoTo 0

' Crée la feuille "Suivi global" si elle n'existe pas
If suiviGlobal Is Nothing Then
Set suiviGlobal = Worksheets.Add(After:=Worksheets(Worksheets.Count))
suiviGlobal.Name = suiviGlobalSheetName
End If

' Trouve la dernière ligne utilisée dans la colonne A de la feuille "Suivi global"
lastRow = suiviGlobal.Cells(suiviGlobal.Rows.Count, "A").End(xlUp).Row

' Ajoute la valeur de la cellule modifiée à la dernière ligne de la colonne A de la feuille "Suivi global"
suiviGlobal.Cells(lastRow + 1, "A").Value = Target.Value

' Réactive les événements
Application.EnableEvents = True
End If
End Sub

Merci à vous.
 
Solution
Mais comment faire pour l'appliquer à l'ensemble des feuilles ?
Vous mettrez cette macro dans le code de ThisWorkbook :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim suiviGlobal As Worksheet
Dim lastRow As Long

' Nom de la feuille de calcul "Suivi global"
Const suiviGlobalSheetName As String = "Suivi global"
If LCase(Sh.Name) = LCase(suiviGlobalSheetName) Then Exit Sub

' Vérifie si la modification concerne la colonne A
Set Target = Intersect(Target, Sh.Columns("A"), Sh.UsedRange)
If Target Is Nothing Then Exit Sub

' Désactive les événements pour éviter une boucle infinie
Application.EnableEvents = False

' Gestion des erreurs pour vérifier si la feuille "Suivi global" existe
On Error...

job75

XLDnaute Barbatruc
Mais comment faire pour l'appliquer à l'ensemble des feuilles ?
Vous mettrez cette macro dans le code de ThisWorkbook :
VB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim suiviGlobal As Worksheet
Dim lastRow As Long

' Nom de la feuille de calcul "Suivi global"
Const suiviGlobalSheetName As String = "Suivi global"
If LCase(Sh.Name) = LCase(suiviGlobalSheetName) Then Exit Sub

' Vérifie si la modification concerne la colonne A
Set Target = Intersect(Target, Sh.Columns("A"), Sh.UsedRange)
If Target Is Nothing Then Exit Sub

' Désactive les événements pour éviter une boucle infinie
Application.EnableEvents = False

' Gestion des erreurs pour vérifier si la feuille "Suivi global" existe
On Error Resume Next
Set suiviGlobal = Worksheets(suiviGlobalSheetName)
On Error GoTo 0

' Crée la feuille "Suivi global" si elle n'existe pas
If suiviGlobal Is Nothing Then
    Set suiviGlobal = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    suiviGlobal.Name = suiviGlobalSheetName
    Sh.Activate
End If

' Boucle au cas où il y a des entrées multiples (copier-coller)
For Each Target In Target
    ' Trouve la dernière ligne utilisée dans la colonne A de la feuille "Suivi global"
    lastRow = suiviGlobal.Cells(suiviGlobal.Rows.Count, "A").End(xlUp).Row

    ' Ajoute la valeur de la cellule modifiée à la dernière ligne de la colonne A de la feuille "Suivi global"
    suiviGlobal.Cells(lastRow + 1, "A").Value = Target.Value
Next Target

' Réactive les événements
Application.EnableEvents = True
End Sub
J'ai ajouté une boucle pour le cas où il y a des entrées multiples (copier-coller).
 

Discussions similaires

Réponses
3
Affichages
139

Statistiques des forums

Discussions
312 867
Messages
2 093 044
Membres
105 619
dernier inscrit
FRNCK