Nommer des nouveaux onglets

[spino91]

Bonjour,

Je ne suis pas très expérimenté en Macro et VBA. Mais à force de persévérance, j'ai réussi à faire ces lignes de code VBA pour une macro.
Elle est presque terminée, mais j'ai encore un détail qui bloque.

Explication macro:
- Création d'un nouvel onglet sur la base d'une feuille type.
- Des liaisons spéciales sont faites entre la nouvelle feuille et un onglet récapitulatif.
- Chaque nouvel onglet doit être renommé automatiquement (1, 2, 3, 4, ...)
- Réalisation d'un lien hypertexte entre chaque nouvelle feuille et la récap.

Le problème est de renommer automatiquement la nouvelle feuille. Vous pouvez voir ci-dessous le programme:

Sub NouvelleFiche()

Sheets("Fiche").Select
Sheets("Fiche").Copy after:=Sheets(Worksheets.Count)
Sheets("Fiche (2)").Select
Sheets("Fiche (2)").Name = "Fiche_"


Sheets("Fiche_").Range("C52").Copy
Sheets("RECAPITULATIF").Activate
ActiveSheet.Range("D65536").End(xlUp)(2).Select
ActiveSheet.Paste Link:=True

Sheets("Fiche_").Range("E52").Copy
Sheets("RECAPITULATIF").Activate
ActiveSheet.Range("E65536").End(xlUp)(2).Select
ActiveSheet.Paste Link:=True

Sheets("Fiche_").Range("F3").Copy
Sheets("RECAPITULATIF").Activate
ActiveSheet.Range("B65536").End(xlUp)(2).Select
ActiveSheet.Paste Link:=True

Sheets("Fiche_").Range("F6").Copy
Sheets("RECAPITULATIF").Activate
ActiveSheet.Range("F65536").End(xlUp)(2).Select
ActiveSheet.Paste Link:=True

Sheets("Fiche_").Range("F8").Copy
Sheets("RECAPITULATIF").Activate
ActiveSheet.Range("A65536").End(xlUp)(2).Select
ActiveSheet.Paste Link:=True

Sheets("Fiche_").Range("F9").Copy
Sheets("RECAPITULATIF").Activate
ActiveSheet.Range("C65536").End(xlUp)(2).Select
ActiveSheet.Paste Link:=True

Sheets("Fiche_").Range("I6").Copy
Sheets("RECAPITULATIF").Activate
ActiveSheet.Range("G65536").End(xlUp)(2).Select
ActiveSheet.Paste Link:=True

Dim D As String

Sheets("Fiche_").Activate

With ActiveSheet
D = .Range("A1").Value + 1
.Range("A1").Value = D
'Nom de l'onglet
.Name = Format(D)
End With

Sheets("RECAPITULATIF").Activate
ActiveSheet.Range("A65536").End(xlUp).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=D + "!F8"

End Sub

Comme vous pouvez le voir la valeur de "D" est prise sur la feuille type, donc A1 toujours = à 0.
Il faudrait que je puisse récupérer la valeur du dernier onglet pour pouvoir l'additionner à 1 et que ce nombre deviennent le nom de la nouvelle feuille.
Si vous avez une autre idée, je suis preneur.

J'attends avec impatience vos réponses en espérant avoir été assez clair.

Cordialement

 

[kjin]

Re : Nommer des nouveaux onglets

Bonsoir,
Le fichier exemple eut été bienvenu

Sub NouvelleFiche()
For Each ws In ActiveWorkbook.Sheets
    If ws.Name Like "Fiche_*" Then
    x = Split(ws.Name, "_")
    If y < x(1) Then y = x(1)
    End If
Next
NewF = "Fiche_" & Int(y) + 1
Application.ScreenUpdating = False
Sheets("Fiche").Copy after:=Sheets(Worksheets.Count)
ActiveSheet.Name = NewF
With Sheets("RECAPITULATIF")
Dl = .Range("A65536").End(xlUp).Row + 1
    .Hyperlinks.Add Anchor:=.Range("A" & Dl), Address:="", SubAddress:= _
        NewF & "!F8", TextToDisplay:=NewF
    'je ne comprends pas cette ligne qui fait doublon avec le lien hypertexte
    '.Range("A65536").End(xlUp)(2).Formula = "=" & NewF & "!F8"
    .Range("B" & Dl).End(xlUp)(2).Formula = "=" & NewF & "!F3"
    .Range("C" & Dl).End(xlUp)(2).Formula = "=" & NewF & "!F9"
    .Range("D" & Dl).End(xlUp)(2).Formula = "=" & NewF & "!C52"
    .Range("E" & Dl).End(xlUp)(2).Formula = "=" & NewF & "!E52"
    .Range("F" & Dl).End(xlUp)(2).Formula = "=" & NewF & "!F6"
    .Range("G" & Dl).End(xlUp)(2).Formula = "=" & NewF & "!I6"
    .Activate
End With
Application.ScreenUpdating = True

End Sub

A+
kjin