View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
DaveM[_2_] DaveM[_2_] is offline
external usenet poster
 
Posts: 77
Default Copy Hyperlinks to other cells

Hi Joe

I have renamed my sheets same as yours, This is what I have in VBE


'You can use the following to do that. Please note that I store the
'hyperlinks in a Scripting.Dictionary for some other reasons. You
'might not have to do that. lSheetORG is the original Worksheet and
'lSheetOUT is the target Worksheet.

Sub HyperList()
Set lHyperLinkList = CreateObject("Scripting.Dictionary")
'Set lSheet = ThisWorkbook.Sheets("lSheetORG")

For Each lHyperlink In lSheetORG.Hyperlinks
Call lHyperLinkList.Add("C" & lHyperlink.Range.Row, lHyperlink.Address)
Next lHyperlink

lSheetOUT.Hyperlinks.Delete

lKeys = lHyperLinkList.keys
lItems = lHyperLinkList.items

For i = 0 To lHyperLinkList.Count - 1
Set lRange = lSheetOUT.Range(lKeys(i))

lSheetOUT.Hyperlinks.Add Anchor:=lRange, Address:=lItems(i),
TextToDisplay:=lRange.Value
Next i
End Sub

Thanks

Dave


"Joe HM" wrote in message
ups.com...
Hello Dave -

This is strange ... works just fine for me and that on a sheet without
any hyperlinks.

Do you have a Sheet1?

Did you try to create something like ...
Set lSheet = ThisWorkbook.Sheets("NAME")
... and use that?

Joe



On Aug 3, 9:29 am, "DaveM" wrote:
Hi Joe

Error Object required

For Each lHyperlink In Sheet1.Hyperlinks

VBE shows yellow debug on line above.

Thanks for your help

Dave

"Joe HM" wrote in message

oups.com...



Set lHyperLinkList = CreateObject("Scripting.Dictionary")


Hello -


You can use the following to do that. Please note that I store the
hyperlinks in a Scripting.Dictionary for some other reasons. You
might not have to do that. lSheetORG is the original Worksheet and
lSheetOUT is the target Worksheet.


Set lHyperLinkList = CreateObject("Scripting.Dictionary")


For Each lHyperlink In lSheetORG.Hyperlinks
Call lHyperLinkList.Add("C" & lHyperlink.Range.Row,
lHyperlink.Address)
Next lHyperlink


lSheetOUT.Hyperlinks.Delete


lKeys = lHyperLinkList.keys
lItems = lHyperLinkList.items


For i = 0 To lHyperLinkList.Count - 1
Set lRange = lSheetOUT.Range(lKeys(i))


lSheetOUT.Hyperlinks.Add Anchor:=lRange, Address:=lItems(i),
TextToDisplay:=lRange.Value
Next i


Hope this works for you ...
Joe


On Aug 3, 8:28 am, "DaveM" wrote:
Hi all


Been trying to do this for over an hour now, with no joy.


sheet1 A1 to A36, The text values that have hyperlinks to files on
harddrive


sheet2 Column A has lots of the same text values as sheet1, some cells
have
a little extra text at the end.


how can I get the hyperlinks from sheet1 to all cells that contain the
same
text, to sheet2


Thanks in advance


Dave- Hide quoted text -


- Show quoted text -