Sub New_Car()
On Error GoTo Error_New_car
' Comptage des véhicules et déverrouillage des feuilles
100 For Each Sh In Sheets
110 Sh.Unprotect
120 If Right$(Sh.Name, 5) = ".Carb" Then indice = indice + 1
130 Next
' Choix d'un nom
150 Message = "Entrez un nom pour le nouveau Véhicule"
160 Title = "Création d'une nouvelle fiche" ' Définit le titre.
170 NomDefault$ = "AUTO" & (indice + 1) ' Définit la valeur par défaut.
180 NomCar2$ = InputBox(Message, Title, NomDefault$, 1000, 2500)
190 If NomCar2$ = "" Then End
195 NomCar2$ = UCase(NomCar2$)
' Suppression des zones nomées avant copie des feuilles
200 Range("A.CUM_ASSUR").Name.Delete
210 Range("A.CUM_PNEUS").Name.Delete
220 Range("A.CUM_JOURS").Name.Delete
230 Range("A.CUM_KM").Name.Delete
240 Range("A.CUM_VIDANGE").Name.Delete
250 Range("A.DER_COMPTEUR").Name.Delete
260 Range("A.DER_DATE").Name.Delete
270 Range("A.DER_KMJ").Name.Delete
' Copie et renomage des feuilles
300 Sheets("A.Entr").Copy after:=Sheets("A.Entr")
310 ActiveSheet.Name = NomCar2$ & ".Entr"
320 [A1] = "ENTRETIEN " & NomCar2$
330 [A14:K1000].ClearContents
340 [C7:F10].ClearContents
350 [I7:K8].ClearContents
360 [I10].ClearContents
370 ActiveWorkbook.Names.Add Name:=NomCar2$ & ".CUM_ASSUR", _
RefersToR1C1:="=" & NomCar2$ & ".Entr!R14C7:R1000C7"
380 ActiveWorkbook.Names.Add Name:=NomCar2$ & ".CUM_PNEUS", _
RefersToR1C1:="=" & NomCar2$ & ".Entr!R14C6:R1000C6"
390 ActiveWorkbook.Names.Add Name:=NomCar2$ & ".CUM_VIDANGE", _
RefersToR1C1:="=" & NomCar2$ & ".Entr!R14C5:R1000C5"
400 Cells.Replace What:="A.", Replacement:=NomCar2$ & ".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
410 [A13].Select
450 Sheets("A.Carb").Copy after:=Sheets("A.Entr")
460 ActiveSheet.Name = NomCar2$ & ".Carb"
470 [A1] = "CARBURANT " & NomCar2$
480 [A14:J1000].ClearContents
490 [I8:J10].ClearContents
500 ActiveWorkbook.Names.Add Name:=NomCar2$ & ".CUM_JOURS", _
RefersToR1C1:="=" & NomCar2$ & ".Carb!R14C6:R1000C6"
510 ActiveWorkbook.Names.Add Name:=NomCar2$ & ".CUM_KM", _
RefersToR1C1:="=" & NomCar2$ & ".Carb!R14C4:R1000C4"
520 ActiveWorkbook.Names.Add Name:=NomCar2$ & ".DER_COMPTEUR", _
RefersToR1C1:="=" & NomCar2$ & ".Carb!R14C2"
530 ActiveWorkbook.Names.Add Name:=NomCar2$ & ".DER_DATE", _
RefersToR1C1:="=" & NomCar2$ & ".Carb!R14C1"
540 ActiveWorkbook.Names.Add Name:=NomCar2$ & ".DER_KMJ", _
RefersToR1C1:="=" & NomCar2$ & ".Carb!R8C8"
550 Cells.Replace What:="A.", Replacement:=NomCar2$ & ".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
560 [A13].Select
600 Sheets("A.Cons").Copy after:=Sheets("A.Km")
610 ActiveSheet.Name = NomCar2$ & ".Cons"
620 ActiveChart.ChartTitle.Characters.Text = "CONSOMMATION " & NomCar2$
630 ActiveChart.SetSourceData Source:=Sheets(NomCar2$ & ".Carb").Range( _
"A14:A1000,G14:G1000"), PlotBy:=xlColumns
650 Sheets("A.Km").Copy after:=Sheets(NomCar2$ & ".Cons")
660 ActiveSheet.Name = NomCar2$ & ".Km"
670 ActiveChart.ChartTitle.Characters.Text = "KILOMETRAGE QUOTIDIEN " & NomCar2$
680 ActiveChart.SetSourceData Source:=Sheets(NomCar2$ & ".Carb").Range( _
"A14:A1000,J14:J1000"), PlotBy:=xlColumns
' Re-création des zones nommées sur feuille origine
700 ActiveWorkbook.Names.Add Name:="A.CUM_ASSUR", _
RefersToR1C1:="=A.Entr!R14C7:R1000C7"
710 ActiveWorkbook.Names.Add Name:="A.CUM_PNEUS", _
RefersToR1C1:="=A.Entr!R14C6:R1000C6"
720 ActiveWorkbook.Names.Add Name:="A.CUM_JOURS", _
RefersToR1C1:="=A.Carb!R14C6:R1000C6"
730 ActiveWorkbook.Names.Add Name:="A.CUM_KM", _
RefersToR1C1:="=A.Carb!R14C4:R1000C4"
740 ActiveWorkbook.Names.Add Name:="A.CUM_VIDANGE", _
RefersToR1C1:="=A.Entr!R14C5:R1000C5"
750 ActiveWorkbook.Names.Add Name:="A.DER_COMPTEUR", _
RefersToR1C1:="=A.Carb!R14C2"
760 ActiveWorkbook.Names.Add Name:="A.DER_DATE", _
RefersToR1C1:="=A.Carb!R14C1"
770 ActiveWorkbook.Names.Add Name:="A.DER_KMJ", _
RefersToR1C1:="=A.Carb!R8C8"
' Verrouiller toutes les feuilles
800 For Each Sh In Sheets
810 Sh.Protect
820 Next
Exit Sub
Error_New_car:
Debug.Print "Ligne numéro=" & Erl(), "Erreur " & Err.Number & " " & Err.Description
Resume Next
End Sub