Correction code

[pascal35135]

Bonjour à tous,
J'arrive presque au bout et merci à vous
J'ai une erreur dans mon code qui au lieu de me faire un lien hypertexte sur une cellule vers une feuille désignée, me fait un lien sur toute la feuille.
Je tâtonne mais!
Cette ligne ne marche pas:
ActiveSheet.Hyperlinks.Add Anchor:=& "Reception" & "!" & "A" & Ligne, Address:="", SubAddress:=Nom & "!A1", TextToDisplay:=Nom
code ci dessous
Merci pour votre aide

Sub Recup()
Dim Fichier() As String
Dim Lecture As String, Chemin As String
Dim Compte As Long
Dim NomFichier As Variant
Dim Onglet As Worksheet
Dim Nom As String, Retour As String
Dim Ligne As Long
Dim Trouve As Range
' Boucle de lecture des fichiers dans un répertoire
Chemin = Range("E11")
Lecture = Dir(Chemin & "*.xls*")
Compte = 0

'Récupération de la liste des fichiers du dossier
Do
ReDim Preserve Fichier(Compte)
Fichier(UBound(Fichier)) = Lecture
Lecture = Dir
Compte = Compte + 1
Loop Until Lecture = ""

'Analyse et recopie éventuelle des onglets Stats
For Each NomFichier In Fichier
Workbooks.Open Filename:=Chemin & NomFichier, ReadOnly:=True
For Each Onglet In Workbooks(NomFichier).Worksheets
If Onglet.Name = "Protocoles_IPR" Then
Nom = Onglet.Range("C1").Value
Set Trouve = ThisWorkbook.Sheets("Reception").Range("A:A").Find(Nom, lookat:=xlWhole)
If Not Trouve Is Nothing Then
Retour = MsgBox("Nom figurant déjà dans la liste réception, voulez vous continuer", vbYesNo, "ALERTE DOUBLONS")
If Retour = vbYes Then
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(Nom).Delete
Application.DisplayAlerts = True
GoTo Reprise
End If
Else
Reprise:
Onglet.Copy after:=ThisWorkbook.Worksheets("Reception")
ThisWorkbook.Worksheets("Protocoles_IPR").Name = Nom
Ligne = ThisWorkbook.Sheets("Reception").Range("A" & Rows.Count).End(xlUp).Row + 1
ThisWorkbook.Sheets("Reception").Range("A" & Ligne) = Nom
'place un lien hypertexte sur nom qui revoie vers la feuille nom


ActiveSheet.Hyperlinks.Add Anchor:=& "Reception" & "!" & "A" & Ligne, Address:="", SubAddress:=Nom & "!A1", TextToDisplay:=Nom


ThisWorkbook.Sheets("Reception").Range("B" & Ligne) = Format(Date, "dd-mm-yyyy")
Exit For
End If
End If
Next
Workbooks(NomFichier).Close False
Next
End Sub

 

[Gelinotte]

Re : Correction code

Bonjour,

Je n'ai pas validé ton code par manque de temps. Mais en enlevant la perluète derrière le égale, la compilation du code ne donne plus d'erreur.

ActiveSheet.Hyperlinks.Add Anchor:= "Reception" & "!" & "A" & Ligne, Address:="", SubAddress:=Nom & "!A1", TextToDisplay:=Nom

G

 

[pierrejean]

Re : Correction code

Bonjour pascal

A tester:

ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Range("A" & Ligne), Address:="", SubAddress:=Nom & "!A1", TextToDisplay:=Nom

Edit: Salut Gelinotte

 

[pascal35135]

Re : Correction code

Bonjour merci à vous deux,
Gelinotte ton code ne fonctionne pas.
Pierrejean ton code est proche de ce que je veux. Le problème est que le lien Nom se trouve sur la feuille importée et non sur Reception.
J'ai rajouté:
Sheets("Reception").Select

Et c'est OK

Merci beaucoup à vous deux.
Ici en Bretagne après le gel, voilà la pluie et tempête.


J

 

[pierrejean]

Re : Correction code

Re
Encore eut-il fallu savoir que la feuille en cours n'ets pas la feuille active
Dans ce cas

ActiveSheet.Hyperlinks.Add Anchor:=Sheets("Reception").Range("A" & Ligne), Address:="", SubAddress:=Nom & "!A1", TextToDisplay:=Nom

est preferable au .Select

 

[pascal35135]

Re : Correction code

Désolé!
Encore merci.

Résolu