Créer un lien hypertexte en même temps que la création d'onglet

Bonjour, dans mon fichier j'ai une macro qui me permet de créer des onglets avec le même nom que les cellules de la colonne A. Je voudrais ajouter en même temps un lien hypertexte qui irait de la cellule à l'onglet du même nom.

voici ma macro pour la création des onglet.

Sub AjouteFeuilles()
Dim J As Long
Dim Ws As Worksheet

Application.ScreenUpdating = False
Set Ws = ActiveSheet
For J = 1 To Ws.Range("A" & Rows.Count).End(xlUp).Row
If Not FeuilleExiste(Ws.Range("A" & J).Value) Then
Sheets("Modèle").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = Ws.Range("A" & J)
End If
Next J
Ws.Select

End Sub

Function FeuilleExiste(Nom As String) As Boolean
On Error Resume Next
FeuilleExiste = Sheets(Nom).Name <> ""
On Error GoTo 0
End Function

Merci pour votre aide

Edit

Bonjour,

Si jamais, j'ai réfléchi au problème entre temps.

En ajoutant ceci dans votre bloc If vous devriez etre bon.

' ********** au debut **********
Dim linkAddress As String
' ******************************

' dans le bloc if, après 
For J = 1 To Ws.Range("A" & Rows.Count).End(xlUp).Row
    If Not FeuilleExiste(Ws.Range("A" & J).Value) Then
      Sheets("Modèle").Copy after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Ws.Range("A" & J)

      linkAddress = "'" & Ws.Range("A" & J).Value2 & "'!A1"
      Ws.Hyperlinks.Add Ws.Range("A" & J), vbNullString, linkAddress, , linkAddress
    End If
  Next J
  Ws.Select

Bonjour, saboh12617

les liens sont bien crées mais cela change le contenu de la cellule. ' '!A1 a été ajouté

cela me gêne car par la suite je vais ajouter d'autre ligne à ma colonne A et donc créer d'autres onglet sans vouloir modifier les onglets déjà créer.

Re,

Prenez le temps de regarder la doc pour ce genre d'ajustements. Comme indiqué ici Hyperlinks.Add method (Excel) | Microsoft Learn, c'est le dernier argument qui indique le texte à afficher. Changez donc le dernier "linkAddress" dans l'instruction .Add par ce que vous voulez (Ws.Range("A" & J).Value en l'occurrence).

Cela fonctionne super.

Merci

Sub AjouteFeuillesavecliens()
Dim J As Long
Dim Ws As Worksheet
Dim linkAddress As String

  Application.ScreenUpdating = False
  Set Ws = ActiveSheet
  For J = 1 To Ws.Range("A" & Rows.Count).End(xlUp).Row
    If Not FeuilleExiste(Ws.Range("A" & J).Value) Then
      Sheets("Modèle").Copy after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Ws.Range("A" & J)

      linkAddress = "'" & Ws.Range("A" & J).Value2 & "'!A1"
      Ws.Hyperlinks.Add Ws.Range("A" & J), vbNullString, linkAddress, , Ws.Range("A" & J).Value
    End If
  Next J
  Ws.Select
End Sub

Parfait, n'oubliez pas de cloturer le fil, c'est une question réccurente et la cloturer proprement serait utile je pense.

Bonne journée.