XL 2010 Appliquer une macro (private sub) dans une feuille qui s'insère aprés le lancement d'une macro

[Laetitia.B]

Bonjour,

Je suis débutante dans les macros et j'éssai de me débrouiller comme je peux pour arriver à mes fins mais là j'ai besoin de vous . Je suis aussi toute nouvelle sur ce site.
Je vous expose mon problème :

J'ai une feuille qui ressemble à un formulaire...rempli par mes collègues. Ce collègue clique sur un bouton (macro) qui copie cette feuille pour ensuite modifier certaines données. Dans cette nouvelle feuille, j'aimerai une macro (ex : private sub) qui colorie les cellules contenant les données modifiées afin de les rendre visuelles. Mon dilemne et comment insérere une macro dans une feuille inexistante à la base ?

Pouvez-vous m'aider, svp ?

Merci d'avance
bonne soirée

 

[Compte Supprimé 979]

Bonjour Laetitia.B

Ce n'est pas comme cela qu'on procède en général

Il faut mettre le code dans ThisWorkbook dans l'évènement

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
End Sub

Mais le code placé à cet endroit va gérer n'importe qu'elle feuille du classeur

Certes il faut trouver une astuce pour savoir si on travaille sur la feuille souhaitée.

Voilà

 

[sylvanu]

Bonjour Laeticia et bienvenue sur XLD, bonjour Bruno,
En PJ une autre approche, avec un module de duplication de la feuille ( qui copie ainsi aussi la macro associée )

Sub DupliqueFeuille()
    ActiveSheet.Copy After:=Sheets(Sheets.Count)    ' Copie de la feuille Référence
    ActiveSheet.Shapes("Bouton").Select             ' Suppression du bouton
    Selection.Delete
End Sub

Et dans la feuille qui doit être copiée une macro événementielle qui compare la cellule modifiée à la cellule de référence.

Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Sheets("Référence").Range(Target.Address) <> Target Then     ' Si valeur <> de la feuille Référence
        Range(Target.Address).Interior.Color = RGB(0, 255, 0)       ' Mettre en vert
    End If
End Sub

A peaufiner évidemment en fonction de votre contexte.

 

[Laetitia.B]

Bonjour Laetitia.B

Ce n'est pas comme cela qu'on procède en général

Il faut mettre le code dans ThisWorkbook dans l'évènement

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
End Sub

Mais le code placé à cet endroit va gérer n'importe qu'elle feuille du classeur

Certes il faut trouver une astuce pour savoir si on travaille sur la feuille souhaitée.

Voilà

merci pour votre réponse, j'ai opté pour la solution de sylvanu mais merci quand même, j'apprécie

 

[Laetitia.B]

Bonjour Laeticia et bienvenue sur XLD, bonjour Bruno,
En PJ une autre approche, avec un module de duplication de la feuille ( qui copie ainsi aussi la macro associée )

Sub DupliqueFeuille()
    ActiveSheet.Copy After:=Sheets(Sheets.Count)    ' Copie de la feuille Référence
    ActiveSheet.Shapes("Bouton").Select             ' Suppression du bouton
    Selection.Delete
End Sub

Et dans la feuille qui doit être copiée une macro événementielle qui compare la cellule modifiée à la cellule de référence.

Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Sheets("Référence").Range(Target.Address) <> Target Then     ' Si valeur <> de la feuille Référence
        Range(Target.Address).Interior.Color = RGB(0, 255, 0)       ' Mettre en vert
    End If
End Sub

A peaufiner évidemment en fonction de votre contexte.

super, c'est exactement, cela ! je ne savais pas ou le mettre et je ne connaissais pas la fonction "target".Merci beaucoup !

Puis-je abuser de votre compétence ? cela concerne ma macro que j'utilise pour copier la feuille. Lorsque que la feuille (normmer 'Fiche projet') se copie, la nouvelle feuille se nomme 'Fiche projet (2)' et ainsi de suite lors de plusieurs copie. J'aimerai dans l'idéale que la feuille copier se renomme par exemple 'fiche projet-avenant_1' et ainsi de suite à chaque fois que j'actionne la macro. La macro doit voir le dernier chiffre aprés le nom de la dernière feuille copié pour ensuite ajouter 2 ou 3 ou 4 ou, ..... Je ne sais pas si je me fais bien comprendre.

Je pense qu'il faut faire une boucle pour la que macro vérifie et incrémente le bon n° ensuite. Mais comment ?

Merci d'avance

 

[sylvanu]

Bonsoir,
Essayez cette PJ avec :

Sub DupliqueFeuille()
    ActiveSheet.Copy After:=Sheets(Sheets.Count)    ' Copie de la feuille Référence
    ActiveSheet.Shapes("Bouton").Select             ' Suppression du bouton
    Selection.Delete
    Dim N%, Nom$: N = 0                             ' N sera l'indice max de fiche projet-avenant_
    Nom = "fiche projet-avenant_"
    For Each Sh In Worksheets                       ' Pour toutes les feuilles
        If Left(Sh.Name, 21) = Nom Then             ' Si feuille concernée ayant un bon nom
            tablo = Split(Sh.Name, "_")             ' On crée un tableau avec "_" comme séparateur
            If Val(tablo(1)) > N Then               ' Si le N° de la feuille est > à l'indice max trouvé
                N = Val(tablo(1))                   ' On récupère cet indice
            End If
        End If
    Next Sh
    ActiveSheet.Name = Nom & N + 1                  ' On renomme la feuille avec l'indice max trouvé +1
End Sub

 

[Compte Supprimé 979]

Bonjour le fil, Sylvanu

Pour moi il y a bien plus simple que de passer par un tableau

Sub DupliqueFeuille()
  Dim Ind As Integer
  Dim Nom As String
  ' Copier la feuille à la fin
  ActiveSheet.Copy After:=Sheets(Sheets.Count)    ' Copie de la feuille Référence
  ActiveSheet.Shapes("Bouton").Delete
  ' Indice de l'avenant
  Ind = 1
  ' Nom de la feuille sans l'indice
  Nom = "fiche projet-avenant_"
  ' En cas d'erreur on continue
  On Error Resume Next
  ' Execute la boucle
  Do
    ' Effacer les erreurs s'il y en a
    Err.Clear
    ' Tente de renommer la feuille
    ActiveSheet.Name = Nom & Ind
    ' incrémente l'indice au cas ou
    Ind = Ind + 1
  ' On recommence tant qu'il y a une erreur
  Loop While Err.Number <> 0
  ' Gestion de l'erreur initiale
  On Error GoTo 0
End Sub

@+

 

[sylvanu]

Bonjour Bruno,
Vous supprimez un tableau de deux éléments que vous remplacez par N renommages de feuilles.
En terme de temps d'exécution vous n'êtes pas gagnant.
Par exemple avec 16 feuilles déjà existantes, le tableau prends 0.082s, le renommage 0.1328s.
L'écart peut sembler faible mais si Laeticia a de nombreuses feuilles, à la longue cela peut être perceptible.

 

[Compte Supprimé 979]

Sylvanu

Merci pour l'info...
il est vrai que perdre quelques millièmes de secondes voir quelques secondes dans ce monde ou tout s'accélère à une vitesse folle... c'est vraiment affreux

J'aime faire des codes que même les novices peuvent comprendre, voilà la différence

Au plaisir

 

[Laetitia.B]

Merci à tous les 2 . Vous apporter tous les 2 une solution qui me convient même si la macro est différente. J'ai opté pour la macro de BrunoM45 qui me convient mieux au vu de mon utilisation.
En tout grâce à vous 2, j'ai mon fichier qui fonctionne nickel. Vous êtes mes mentors !

Bonne journée à vous

 

[Laetitia.B]

Bonjour le fil, Sylvanu

Pour moi il y a bien plus simple que de passer par un tableau

Sub DupliqueFeuille()
  Dim Ind As Integer
  Dim Nom As String
  ' Copier la feuille à la fin
  ActiveSheet.Copy After:=Sheets(Sheets.Count)    ' Copie de la feuille Référence
  ActiveSheet.Shapes("Bouton").Delete
  ' Indice de l'avenant
  Ind = 1
  ' Nom de la feuille sans l'indice
  Nom = "fiche projet-avenant_"
  ' En cas d'erreur on continue
  On Error Resume Next
  ' Execute la boucle
  Do
    ' Effacer les erreurs s'il y en a
    Err.Clear
    ' Tente de renommer la feuille
    ActiveSheet.Name = Nom & Ind
    ' incrémente l'indice au cas ou
    Ind = Ind + 1
  ' On recommence tant qu'il y a une erreur
  Loop While Err.Number <> 0
  ' Gestion de l'erreur initiale
  On Error GoTo 0
End Sub

@+

Parfait, elle fonctionne nickel !
Merci

 

[Laetitia.B]

Bonsoir,
Essayez cette PJ avec :

Sub DupliqueFeuille()
    ActiveSheet.Copy After:=Sheets(Sheets.Count)    ' Copie de la feuille Référence
    ActiveSheet.Shapes("Bouton").Select             ' Suppression du bouton
    Selection.Delete
    Dim N%, Nom$: N = 0                             ' N sera l'indice max de fiche projet-avenant_
    Nom = "fiche projet-avenant_"
    For Each Sh In Worksheets                       ' Pour toutes les feuilles
        If Left(Sh.Name, 21) = Nom Then             ' Si feuille concernée ayant un bon nom
            tablo = Split(Sh.Name, "_")             ' On crée un tableau avec "_" comme séparateur
            If Val(tablo(1)) > N Then               ' Si le N° de la feuille est > à l'indice max trouvé
                N = Val(tablo(1))                   ' On récupère cet indice
            End If
        End If
    Next Sh
    ActiveSheet.Name = Nom & N + 1                  ' On renomme la feuille avec l'indice max trouvé +1
End Sub

Merci ! elle fonctionne mais parfoit (pas à chaque clic) j'ai une erreur de fusion dans le tableau et il me modifie un peu mon format de tableau...bizarre. Cependant j'ai choisi la solution de BrunoM45 mais la vôtre était bien également. Le plus de la vôtre est que si je supprime une feuille (le 3ème feuille avenant), elle continue l'ordre 4,5,6 que celle de BrunoM45 comble les feuilles manquantes (dans la numérotation).

En tout cas, MERCI et aussi de votre réactivité

Bonne journée