EXCEL VBA: How To: Copy Hyperlink while Preserving Target Format [RESOLVED]

Esteemed Forum Participants and Lurkers:
===============================
Excel 2003 VBA

I need a process (code) to copy Hyperlinks from a cell on one sheet to a specific related cell on another sheet while preserving the format of the target cell. The Target Cell may have any number of different background and border formats. For test, it can all be on the same sheet from one column to another.

If I copy the source cell and paste it on the destination cell, it overwrites the destination cell format, but that appears to be the only way I can copy the link. There doesn't seem to be any "Paste Special" to paste just the Hyperlink. Paste Special Values doesn't work ... paste special formulas doesn't work ... etc. ad nauseam.

I tried to copy just the format from the TARGET cell and paste it on the Source cell so that I could then copy the identically formatted Source cell back on the Target cell, but when I paste the format, it crashes the Hyperlink, leaving only the link text.

Is there any quick and dirty way to do this without having to save every format property of each target cell and then rewrite them all?

What about the following:

VB Code:

Dim h as Hyperlink
 
For each h in SourceRange
 
MyWorkSheet.Hyperlinks.Add TargetRange, h.Address
 
Next h

It's easy enough to adapt if you need the link moved.

zaza

Thsnks zaza ... we are sooooo close! The "Hyperlinks" collection has to be added after the source range! Your suggestion does indeed copy just the hyperlink without affecting the destination cell formatting. However, in my case, the destination cell depends on the address of the source cell, and I can't figure out the range address of each hyperlink cell "hLink". As you can see, I have tried everything I could find ...

Code:

---

Option Explicit
Sub junk()
    Dim aSheet As Worksheet
    Dim hLink As Hyperlink
    Dim i As Integer
   
    Set aSheet = ActiveWorkbook.Sheets("TEST")
    i = 1
    For Each hLink In aSheet.Range("B1:B18").Hyperlinks  'A simple test range ... real range is complex
        aSheet.Hyperlinks.Add aSheet.Cells(i, "D"), hLink.Address, , , cStr(hLink.Parent)
       
        Debug.Print hLink.Address 'This is the URL
        Debug.Print hLink.Parent  'This PRINTS the Link Text - Actually is the RANGE !!!
        Debug.Print hLink.Creator '??? a process handle?
        Debug.Print hLink.Range  'This is also the Link Text
        Debug.Print hLink.Type    '???
       
        i = i + 1
    Next hLink

End Sub

---

How can I find the ADDRESS of the elements of the Hyperlinks collection?

I got it ... hLink.Range.Address

Thanks zaza ... you're input was excellent ... just what I needed! Your rating gets bumped up a notch!

Here is the final working TEST code:

Code:

---

Option Explicit
Sub HyperlinkMoveTest()
    Dim aSheet As Worksheet 'Sheet Handle
    Dim hLink As Hyperlink  'Hyperlink Handle
    Dim rngDst As Range    'Destination Cell
    Dim rngSrc As Range    'Source Cell
   
    'Set a Handle for the working Sheet
    Set aSheet = ActiveWorkbook.Sheets("TEST")
    'Iterate through all the Hyperlinks in a range
    For Each hLink In aSheet.Range("B1:B18").Hyperlinks
        'Fetch the cell address of the source Hyperlink
        Set rngSrc = hLink.Range
        'Set the Destination Cell address based on the Source Cell address
        Set rngDst = rngSrc.Offset(0, 2)
        'Load the Destination Cell with the Hyperlink WITHOUT AFFECTING THE FORMAT !!!
        aSheet.Hyperlinks.Add rngDst, hLink.Address, , , hLink.Range.Text
    Next hLink
End Sub

---

Thanks again, zaza

can u helpm with my problem

have the hyperlinks in a cell just tryin to put the hyperlink in the body of an email, can get text but want the link

code is =

Code:

---


Sub NEWACTION()
Dim OutApp As Object
Dim OutMail As Object
Dim EmailAddr As String
Dim Subj As String
Dim BodyText As String
Dim hLink As Hyperlink

EmailAddr = Sheets(CurrentSheet).Cells(RowNumber, 9)
Subj = " You Have Been Assigned Reponsibilty For the Following Action! "

BodyText = " You have been assigned an Action of - " & Sheets(CurrentSheet).Cells(RowNumber, 5) & " - To Be Completed by - " & Sheets(CurrentSheet).Cells(RowNumber, 8) & vbCr & vbLf & vbCr & vbLf
hLink = Sheets(CurrentSheet).Cells(RowNumber, 2).Hyperlinks
BodyText = BodyText & hLink

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = EmailAddr
.BCC = ""
.Subject = Subj
.Body = BodyText
'.Attachments.Add ActiveWorkbook.FullName
.Display 'or use
.send
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

---

can u help its not pickin up the hyperlink ok cheers

Robbo ... (Is that an "Old Tanglefoot" in your personal icon?)

It's been awhile since I have had VBA open, and I have no experience with auto generating e-mails ... but ... and I'm just guessing here ... if you want 'funny' stuff in an e-mail, don't you have to format it in HTML? For that you'll just need an href line ...

Code:

---

To open the link in a new page:
<A href="...url.goes.here..." target=_blank> link text </A>
To open the link in the active page already open ...
<A href="...url.goes.here..." target=_self> link text </A>

---

The "target" specifier is optional. I think you can just plug in the extra canned HTML text strings around the URL text you fetch out of the cell and whatever you want for the Link Text. You've probably already figured this out?

Hope this helps ... let me know if you need more help or if I got lucky!
Blessings in abundance, all the best, and ENJOY!
Art in Carlisle PA USA

The code below is very similar to what I want to do with my excel file. I want to copy just the hyperlinks from a 200 row, 2 column selection and place them in the same place in a different sheet. Can anyone help me out? I've never done this before and also need help with how to rename the stuff so that it works for my files. (such as the Set aSheet line)

Option Explicit
Sub HyperlinkMoveTest()
Dim aSheet As Worksheet 'Sheet Handle
Dim hLink As Hyperlink 'Hyperlink Handle
Dim rngDst As Range 'Destination Cell
Dim rngSrc As Range 'Source Cell

'Set a Handle for the working Sheet
Set aSheet = ActiveWorkbook.Sheets("TEST")
'Iterate through all the Hyperlinks in a range
For Each hLink In aSheet.Range("B1:B18").Hyperlinks
'Fetch the cell address of the source Hyperlink
Set rngSrc = hLink.Range
'Set the Destination Cell address based on the Source Cell address
Set rngDst = rngSrc.Offset(0, 2)
'Load the Destination Cell with the Hyperlink WITHOUT AFFECTING THE FORMAT !!!
aSheet.Hyperlinks.Add rngDst, hLink.Address, , , hLink.Range.Text
Next hLink
End Sub

Thank you. The code worked great. This is my final code. Takes the list of companies in column A and moves the actual hyperlink to column C.

Sub HyperlinkMoveTest()
Dim aSheet As Worksheet 'Sheet Handle
Dim hLink As Hyperlink 'Hyperlink Handle
Dim rngDst As Range 'Destination Cell
Dim rngSrc As Range 'Source Cell

'Set a Handle for the working Sheet
Set aSheet = ActiveWorkbook.Sheets("TEST")
'Iterate through all the Hyperlinks in a range
For Each hLink In aSheet.Range("A1:A193").Hyperlinks
'Fetch the cell address of the source Hyperlink
Set rngSrc = hLink.Range
'Set the Destination Cell address based on the Source Cell address
Set rngDst = rngSrc.Offset(0, 2)
'Load the Destination Cell with the Hyperlink WITHOUT AFFECTING THE FORMAT !!!
aSheet.Hyperlinks.Add rngDst, hLink.Address
Next hLink
End Sub

This is exactly what I was looking for and it works except for one issue. It copies my hyperlinks to the next column but I have a DrillDown Sub Selection.ShowDetail = True. My hyperlinks point other sheets in the workbook that have pivot tables. I wanted the users to be able to click on the hyperlink and see the detail behind the pivot cell it was pointing to instead of the summed total. This code does not copy the DrillDown Sub part. I apologize in advance but I don't know how to easily add that back in. Below is your code that I tweaked to work with my workbook:

Sub HyperlinkMoveTest()
Dim aSheet As Worksheet 'Sheet Handle
Dim hLink As Hyperlink 'Hyperlink Handle
Dim rngDst As Range 'Destination Cell
Dim rngSrc As Range 'Source Cell

'Set a Handle for the working Sheet
Set aSheet = ActiveWorkbook.Sheets("Trending")
'Iterate through all the Hyperlinks in a range
For Each hLink In Selection.Hyperlinks
'Fetch the cell address of the source Hyperlink
Set rngSrc = hLink.Range
'Set the Destination Cell address based on the Source Cell address
Set rngDst = rngSrc.Offset(0, 1)
'Load the Destination Cell with the Hyperlink WITHOUT AFFECTING THE FORMAT !!!
aSheet.Hyperlinks.Add rngDst, hLink.Address, hLink.Range.Text
Next hLink
End Sub

Thank you in advance.

This is related to the problem i have in the excel, the task is to copy the hyperlink data from a particular column in Excel and when i click a Macro button it should automatically
fetch the data from that particular column of Excel. Can anyone sugget me solution...?