perte des liens hypertextes lors de la copie sur un nouvel onglet

[choupett]

Bonjour

Merci pour ce forum qui nous eclaire dans nos recherches..

Je recois deux fichiers par semaine, que je croise sur un onglet dans une nouveau fichier et ensuite je separe sur un onglet les valeurs uniques et les valeurs en doublons grâce à une macro VBA.

Mon souci est que sur l'onglet BD j'ai bien mes liens internets, mais lors de l'application de la macro et le transferts sur l'onglet unique et doublons, les liens hypertextes ont disparus.
Que doit je modifier ou faire pour que mes liens hypertextes restent actifs ?

Je vous joins le fichier afin que ca soit plus explicite.

Merci d'avance pour vos réponses

 

[Odesta]

Re : perte des liens hypertextes lors de la copie sur un nouvel onglet

Bonjour

Un programme qui remet les liens hypertext, appelé par les deux fonctions Uniques et Doublons

Sub Doublons()
    Range("C3").Select
    Sheets("BD").Range("A1:AB400").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("AD1:AD2"), CopyToRange:=Range("A1:AB1"), Unique:=True
    Range("AD2").Select
    
    Call recup_des_liens("Doublons")


End Sub
Sub Uniques()

    Sheets("BD").Range("A1:AB400").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("AD1:AD2"), CopyToRange:=Range("A1:AB1"), Unique:=False
    Call recup_des_liens("Unique")
End Sub

Sub recup_des_liens(ByRef feuille As String)


'Pour toutes les cellules de la feuille choisie : (par lignes, puis par colonnes)

For i = 2 To Sheets(feuille).Range("A65000").End(xlUp).Row
    For l = 2 To Sheets("BD").Range("A65000").End(xlUp).Row
        If Sheets("BD").Cells(l, 1) = Sheets(feuille).Cells(i, 1) Then 'si l'immatriculation est présante dans la feuille BD
            For y = 12 To 28 'pour toutes les lignes
                If Sheets("BD").Cells(l, y).Value <> "" Then 'si il y a un contenu
                    adresse = Sheets("BD").Cells(l, y).Hyperlinks.Item(1).Name 'récupérer l'adresse
                    Cells.Hyperlinks.Add Anchor:=Sheets(feuille).Cells(i, y), Address:=adresse 'l'ajouter à la cellule
                End If
            Next y

        End If
    Next l
Next i

End Sub

Cordialement

Olivier

 

[choupett]

Re : perte des liens hypertextes lors de la copie sur un nouvel onglet

Merci beaucoup olivier tu viens de résoudre mon soucis qui va me permettre de gagner du temps au quotidien !!

Cdlt