Macro - Hypertext sans modifier la cellule

Bonjour

débutant dans les macro, je sollicite votre aide.

En effet j'ai une liste de documents en cellule B (500 lignes) et leurs liens respectifs en cellule C et je voudrais créer une macro qui copie colle les liens vers leurs noms de documents respectifs sans modifier le nom du document.

En gros pouvoir cliquer sur le nom du document et arriver sur le "site"

l'essaie avec l'enregistreur donne ceci:

Sub Macro3()
'
' Macro3 Macro
'
'
    Range("C7").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    ActiveCell.FormulaR1C1 = "http://www.swissgenetics.ch"
    Range("B6").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        "http://www.swissgenetics.ch", TextToDisplay:="Doc 1"
End Sub

mais j’arrive pas a le répéter pour les 500 ligne sachant en plus qu'il y'a des case vide a prendre en compte (donc a sauter et continuer si t’a pas de lien)

Merci de votre aide

Bonsoir,

Sub TftHpl()
    Dim adr$, n%, i%
    With ActiveSheet
        n = .Cells(.Rows.Count, 3).End(xlUp).Row
        Application.ScreenUpdating = False
        For i = 7 To n Step 3
            On Error Resume Next
            adr = .Cells(i, 3).Hyperlinks(1).Address
            If Err.Number = 0 Then
                .Hyperlinks.Add .Cells(i - 1, 2), adr
            Else
                Err.Clear
            End If
        Next i
    End With
End Sub

merci MFerrand

ça marche super bien avec mon fichier