Macro création lien hypertexte

Bonjour à tous,

Après plusieurs jours de recherches sur le forum, je n'arrive toujours pas à mettre en œuvre mon idée.

Quand je saisie dans un nouveau devis, cela met à jour automatiquement la feuille "suivi devis facture" contenant la liste de tous mes devis.

Sur cette feuil, la macro cherche la dernière ligne vide et inscrit le numéro du devis dans la première colonne "A" . Ce numéro se trouve en "i3" de mon nouveau devis.

Je n'arrive pas à créer ce numéro en lien hypertexte pour retrouver plus facilement mon devis.

Je vous joins ma macro

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim NomOnglet As String
Dim NomClient As String
Dim WsDepart As Worksheet
Dim WsDestination As Worksheet

On Error Resume Next

If Not Intersect(Target, Range("b15:i76")) Is Nothing Then

Set WsDestination = Sheets("SuiviDevisFacture")
Set WsDepart = ActiveSheet

NomClient = WsDepart.Range("i3").Value 'ActiveSheet.Name

Set c = WsDestination.Columns("A:A").Find(What:=NomClient, LookIn:=xlValues, LookAt:=xlPart)
If c Is Nothing Then
    'MsgBox "on créé la ligne"
    Set c = WsDestination.Range("A" & WsDestination.Range("A" & WsDestination.Cells.Rows.Count).End(xlUp).Row + 1)
End If

c.Value = WsDepart.Range("i3") '------Numéro de devis : cette ligne copie le numéro du devis en destination de la feuil "suiviDevisFacture". Comment le créer en lien hypertexte?
c.Offset(0, 1).Value = WsDepart.Range("H9") 'Nom du client
c.Offset(0, 2).Value = WsDepart.Range("d15") 'Date de l'évenement
c.Offset(0, 3).Value = WsDepart.Range("E15") 'Lieu de l'évenement
c.Offset(0, 4).Value = WsDepart.Range("G15") 'Heure de l'evenement
c.Offset(0, 5).Value = WsDepart.Range("B19") 'Type de prestation
c.Offset(0, 6).Value = WsDepart.Range("I73").Value 'N°Devis
c.Offset(0, 8).Value = WsDepart.Range("G19") 'Nombre de personne
c.Offset(0, 18).Value = Date 'Nombre de personne
c.Offset(0, 19).FormulaR1C1 = "=RC[-1]+22"
End If
End Sub

Merci pour votre aide

Bonjour,

Je n'arrive pas à créer ce numéro en lien hypertexte pour retrouver plus facilement mon devis.

Je n'ai pas tout à fait compris. Votre devis se trouve où en fait ?

Cordialement

Bonjour Dan,

Le devis se trouve dans le même classeur.

J'ai une feuille "SuiviDevisFacture" ou je répertorie tous les devis.

Ensuite je crée une feuille pour chaque nouveau devis : devis1, devis2, devis3...

Par exemple, l'idée est que le nombre 1 de devis"1" positionné en "i3" devienne un lien hypertexte lorsque qu'il copier dans la feuille "suiviDevisFacture" pour retrouver facilement Devis1

On peut faire par lien hypertexte mais vous pourriez aussi faire par double click sur le numéro du devis

Votre avis ?

Oui aussi ca serait parfait

Vos numéros commencent sur quelle cellule en colonne A (donc la première... A1, A2 ??) et sur quelle feuille ?

edit : bon pas de retour... essayez ceci. Code à placer dans la feuille où vous mettez vos numéros de devis

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    On Error Resume Next
    Sheets("devis" & Target.value).Select
End If
End Sub

On suppose que le 1er numéro est en A2

Si ok, pensez à

Crdlt

C'est parfait!!!

J'ai adapté le code que je dépose en dessous si cela peut aider....

Un grand merci à toi

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    On Error Resume Next
    Sheets("DEVIS N°23-" & Target.Value).Select
End If
If Not Intersect(Target, Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    On Error Resume Next
    Sheets("FACTURE N°23-" & Target.Value).Select
End If
End Sub