copie de liens hypertexte

Sub CopierLiens()
Dim c As Range
On Error Resume Next
For Each c In [A:A].SpecialCells(xlCellTypeConstants, 2)
    With c.Hyperlinks(1)
        c(1, 2).Hyperlinks.Add c(1, 2), .Address, TextToDisplay:=c(1, 2).Text
        c(1, 2).Hyperlinks.Add c(1, 2), .Address, .SubAddress, TextToDisplay:=c(1, 2).Text
    End With
Next
End Sub

Sub Macro1()
Dim xcell As Range
   For Each xcell In Selection
      If xcell <> "" Then
         If xcell.Offset(, -1).Hyperlinks.Count > 0 Then
            xcell.Hyperlinks.Add Anchor:=xcell, _
            Address:=xcell.Offset(, -1).Hyperlinks(1).Address, _
            TextToDisplay:=xcell.Value
         End If
      End If
   Next xcell
End Sub[/B]

Sub CopierLiens2()
Dim mem
With ActiveSheet.UsedRange
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    mem = .Columns(2)
    .Columns(1).Copy .Columns(2)
    .Columns(2) = mem
End With
End Sub