Re : Macro recopier une feuille contenant des liens hypertexts en renomant les onglet
Bonjour,
Voici le code modifié :
Sub to_test() ' dans colonne C2:C que nouvelles feuilles ajoutées avec nom repris des cellules C:C
Dim plage As Range
Dim cn As Range
Dim n As Long
Dim MonNom As String
Application.ScreenUpdating = False
Sheets("liste th").Activate
n = Sheets.Count
Set plage = Range("B7:B" & Range("B65536").End(xlUp).Row)
For Each cn In plage
If cn <> "0" And cn <> "" Then
MonNom = IIf(Len(cn.Value) > 32, Left(cn.Value, 31), cn.Value)
On Error Resume Next
Sheets("Feuil1").Copy After:=Sheets(Sheets.Count) 'on copie la feuille 1, copie qu'on place en fin
For i = 1 To ActiveSheet.Hyperlinks.Count 'de 1 jusqu'au nombre de liens hypertexte dans la feuille
x = InStr(1, ActiveSheet.Hyperlinks(i).SubAddress, "!") 'on calcule la position du ! dans le lien
y = Right(ActiveSheet.Hyperlinks(i).SubAddress, Len(ActiveSheet.Hyperlinks(i).SubAddress) - x)
ActiveSheet.Hyperlinks(i).SubAddress = "'" & ActiveSheet.Name & "'" & "!" & y
Next i
ActiveSheet.Name = MonNom
End If
Next cn
End Sub
@ +
Juju