[COLOR="DarkSlateGray"]Sub Macro1()
Dim vm As Integer 'déclare la variable vm (Valeur Maximum)
Dim sh As Worksheet 'déclare la variable sh (SHeet)
Dim n As String 'déclare la variable n (Nom)
Dim chem As String 'déclare la variable chem (CHEMin)
chem = ThisWorkbook.Path & "\" 'définit la variable chem
vm = (1) 'définit la variable vm
For Each sh In Sheets 'boucle sur tous les onglets du classeur
'si la valeur convertie en entier de E4 est supérieure à vm, alors vm prend cette valeur
sh.Unprotect
If CInt(sh.Range("E4")) > vm Then vm = CInt(sh.Range("E4"))
Next sh 'prochain onglet de la boucle (à la fin, vm à pris la plus grande valeur)
'boite d'entrée pour demander le nom du fichier copié
n = InputBox("Donnez le nom au nouveau fichier. Sans l'extension !", "RENOMMER")
If n = "" Then Exit Sub 'si aucun nom n'est édité, sort de la procédure
ActiveWorkbook.SaveAs Filename:=chem & n & ".xls" 'copie le classeur avec le nom proposé
'Oter la protection de la feuille
ActiveSheet.Unprotect
Range("E4").Select
Selection.Copy
Range("G19").Select
ActiveSheet.Paste
For Each sh In Sheets 'boucle sur tous les onglets du nouveau classeur
'si E4 de l'onglet n'est pas vide, ajoute vm à la valeur de E4
If sh.Range("E4") <> "" And sh.Name <> "XXX MODELE" _
And sh.Name <> "feuil1" And sh.Name <> "Consignations élec CR" Then
[B][COLOR="Red"]sh.Range("E4").Copy Destination:=sh.Range("G19")[/COLOR][/B]
sh.Range("E4") = vm + 1: sh.Name = vm + 1: vm = vm + 1
End If
Next sh 'prochain onglet de la boucle
ActiveSheet.Protect 'Protéger la feuille
ActiveWorkbook.Save 'sauve le nouveau classeur
End Sub[/COLOR]
