Bonjour,
A placer dans un module standard :
Sub Test()
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim DerniereLigne As Long, DerniereColonne As Long, LigneEnCours As Long, I As Long
Dim Aire As Range
Set Sh2 = Sheets("Feuil2")
With Sh2
.Range("A1").CurrentRegion.Clear
.Range("A1:B1") = Array("Référence", "Cellule")
LigneEnCours = 2
End With
Set Sh1 = Sheets("Feuil1")
With Sh1
DerniereLigne = .Cells.SpecialCells(xlCellTypeLastCell).Row
DerniereColonne = .Cells.SpecialCells(xlCellTypeLastCell).Column
Set Aire = .Range(.Cells(1, 1), .Cells(DerniereLigne, DerniereColonne))
End With
For I = 1 To Aire.Count
If InStr(1, Aire(I), "LVS") > 0 Then
With Sh2
.Cells(LigneEnCours, 1) = Aire(I)
.Hyperlinks.Add Anchor:=Sh2.Cells(LigneEnCours, 2), Address:="", SubAddress:=Sh1.Name & "!" & Aire(I).Address, TextToDisplay:=Aire(I).Address
End With
LigneEnCours = LigneEnCours + 1
End If
Next I
Set Sh1 = Nothing: Set Sh2 = Nothing: Set Aire = Nothing
End Sub