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.

 

[RoryA]

That code doesn't actually do anything. Can you post the code that actually transfers the cells?

 

[RetroManHD]

That code doesn't actually do anything. Can you post the code that actually transfers the cells?

Apologies, here' the full code:

    Dim Sh As Worksheet
    Dim Newsh As Worksheet
    Dim myCell As Range
    Dim ColNum As Integer
    Dim RwNum As Long
    Dim Basebook As Workbook
   
    Set Basebook = ThisWorkbook
    Set Newsh = Basebook.Worksheets("Orders")
    Newsh.Rows("5:" & Newsh.Rows.Count).Clear
        
'The links to the first sheet will start in row 2
    RwNum = 3
    For Each Sh In Basebook.Worksheets
    If Sh.Name <> Newsh.Name And Sh.Visible Then
    ColNum = 1
    RwNum = RwNum + 1
            
'Create a link to the sheet in the A column
    Newsh.Hyperlinks.Add Anchor:=Newsh.Cells(RwNum, 1), Address:="", _
    SubAddress:="'" & Sh.Name & "'!A1", TextToDisplay:=Sh.Name
                            
    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
            
            End If
        
    Next Sh

What basically happens, as you can probably tell from the code, a sheet called Orders is created and pulls info from the cells ("J9,D9,D13,O66,D8,A1") from all other sheets created.

 

[RoryA]

You can't return a hyperlink like that. Would it be OK to simply copy that cell across directly, or do you actually need the two cells linked?

 

[RetroManHD]

You can't return a hyperlink like that. Would it be OK to simply copy that cell across directly, or do you actually need the two cells linked?

Ideally they need to be linked... the Orders sheet links to the cells J9,D9,D13,O66,D8,A1 from all other created sheets automatically. Users can access the link from the other sheets, the Orders sheet just collates certain cells creating a list with the most important data and cell A1 is a hyperlink to a PDF attachment.

If it can't be done, I'll just have to re think the hyperlink scenario.


Thanks for your time...

Steven.

 

[RoryA]

What exactly is in A1 on the source sheet? If it's the path to the file, you could use a HYPERLINK formula to create the link in the new sheet.

 

[RetroManHD]

What exactly is in A1 on the source sheet? If it's the path to the file, you could use a HYPERLINK formula to create the link in the new sheet.

Yes, that's exactly what A1 is, it's a user created Hyperlink to a PDF file on the Server. The current code just doesn't copy the Hyperlink across.

 

[RoryA]

Does the displayed text include the file path, or just the file name?

 

[RetroManHD]

Does the displayed text include the file path, or just the file name?

Just the file name...

 

[RoryA]

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