Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Worksheet, ThisSH As Worksheet
Dim xCell As Range, Renomme As Boolean
Application.EnableEvents = False
Application.ScreenUpdating = False
Set ThisSH = ActiveSheet
If Not Intersect(Target, Range("b3:b28")) Is Nothing Then
'pour chaque cellule modifiée
For Each xCell In Intersect(Target, Range("b3:b28"))
Renomme = False
'pour chaque feuille du classeur
For Each sh In Worksheets
'recherche de la feuille correspondante
If sh.Range("B5").FormulaLocal = "=NOMPROPRE('noms du personnel'!B" & xCell.Row & ")" Then
'c'est une feuille planning individuelle qui correspond au nom de la ligne traitée
'on change son nom
If Trim(xCell.Text) <> "" Then
sh.Name = sh.Range("B5").Text
Renomme = True
Else
'le nom est vide - on pourrait ici détruire ou archiver la feuille
If MsgBox("Détruire la feuille [" & sh.Name & "] ?", vbCritical + vbYesNo + vbDefaultButton2) = vbYes Then
sh.Delete
Renomme = True
End If
End If
If Renomme Then Exit For
End If
Next sh
If Not Renomme Then
'on copie la feuille modèle
If Trim(xCell.Text) <> "" Then
Sheets("Modele").Copy After:=Sheets(Sheets.Count)
'On applique les bonnes formules
ActiveSheet.Range("B5").FormulaLocal = "=" & Replace(Sheets("Modele").Range("B5").FormulaLocal, 999999, xCell.Row)
ActiveSheet.Range("D5").FormulaLocal = "=" & Replace(Sheets("Modele").Range("D5").FormulaLocal, 999999, xCell.Row)
ActiveSheet.Range("G5").FormulaLocal = "=" & Replace(Sheets("Modele").Range("G5").FormulaLocal, 999999, xCell.Row)
ActiveSheet.Name = ActiveSheet.Range("B5").Text
End If
End If
Next xCell
End If
ThisSH.Activate
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub