Macro recopier une feuille contenant des liens hypertexts en renomant les onglets

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

christophe900

XLDnaute Nouveau
Bonjour,

Sur le fichier joint, deux macros.

La première recopie la feuille 2 le nombre que fois que je veux, en conservant les liens hypertexts. (TRES IMPORTANT)
La deuxième creer des feuilles en renomant les onglets avec des noms dans une liste.

Je voudrais au finale faire du deux en un. une macro qui recopie la feuille "feuil1" autant de fois qu'il y a de nom dans la colonne nom de la feuille "liste th", en renomant les onglets avec le nom des personnes. TOUT EN CONCERVANT LES LIENS HYPERTEXT DE LA FEUILLE 1.

D'avance merci
 

Pièces jointes

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
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
40
Affichages
1 K
Réponses
7
Affichages
166
Retour