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

BrunoM45 à dit:

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

VB:

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à

Cliquez pour agrandir...

sylvanu à dit:

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 )

VB:

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.

Code:

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.

Cliquez pour agrandir...

BrunoM45 à dit:

Bonjour le fil, Sylvanu

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

VB:

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

@+

Cliquez pour agrandir...

sylvanu à dit:

Bonsoir,
Essayez cette PJ avec :

VB:

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

Cliquez pour agrandir...