VBA to copy hyperlink

[RetroManHD]

Hi guys,

I have a line of code in my macro as below:

The code is: For Each myCell In Sh.Range("J9,D9,D13,O66,D8,A1")

There is more to the macro, but this line basically copies the information of cells from one sheet to cells in another sheet. The problem I'm having is that the final cell 'A1' is a hyperlink to a file on my computer and the hyperlink does not copy across, but the text in the cell does.

I'm wondering does anyone know how I can change the code above so the hyperlink copies across.

Thanks,
Steven.

 

[RetroManHD]

Then you'll need a UDF in the file to extract the actual path of the hyperlink. So you could add this:

Function HLinkPath(Cell As Range) As String
    On Error Resume Next
    HLinkPath = Cell(1).Hyperlinks(1).Address
End Function

to your module. Then alter your current code to this:

    For Each myCell In Sh.Range("J9,D9,D13,O66,D8,A1")
    
    
    ColNum = ColNum + 1
    if mycell.address(0,0) = "A1" then
Newsh.Cells(RwNum, ColNum).Formula = _
    "=HYPERLINK(HLinkPath('" & Sh.Name & "'!" & myCell.Address(False, False) & "))
    else
    Newsh.Cells(RwNum, ColNum).Formula = _
    "='" & Sh.Name & "'!" & myCell.Address(False, False)
    end if       
        Next myCell

I'll give this a try and let you know...

Thanks, Rory.

 

[RetroManHD]

Apologies, Rory, but could you advise as to where in my current code I would copy the Function code, also when I paste the altered code, I keep getting a Next without For error?!?!

 

[RoryA]

The function code needs to be in a normal module (doesn't matter which) not a worksheet or ThisWorkbook code module.

the other code replaces this in your original:

    For Each myCell In Sh.Range("J9,D9,D13,O66,D8,A1")
    
    
    ColNum = ColNum + 1
    Newsh.Cells(RwNum, ColNum).Formula = _
    "='" & Sh.Name & "'!" & myCell.Address(False, False)
                
        Next myCell