View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Joe HM Joe HM is offline
external usenet poster
 
Posts: 92
Default Copy Hyperlinks to other cells

Hello -

I tweaked the code you sent in your last message. You just need to
rename SOURCE and TARGET to whatever the worksheets are called (i.e.
the names of their tabs).

Sub HyperList()
Set lHyperLinkList = CreateObject("Scripting.Dictionary")

Set lSheetORG = ThisWorkbook.Sheets("SOURCE")
Set lSheetOUT = ThisWorkbook.Sheets("TARGET")

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

Joe



On Aug 3, 10:34 am, "DaveM" wrote:
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


groups.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 -- Hide quoted text -


- Show quoted text -