Backup your workbooks before executing this macro

It will prompt for file, and then opens the workbook,selects Sheet1,
and apply the links to the opened workbook.

Sub MakeHyperlink()
Dim file_open As Variant
Dim org_workbook As Variant
org_workbook = ActiveWorkbook.Name
file_open = Application.GetOpenFilename()

Workbooks.Open Filename:=file_open
Worksheets("Sheet1").Select
Range("B7").Select
Dim strCellData As Variant

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("G7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("N7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("X7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("AG7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

Range("AO7").Select

Do Until ActiveCell.Value = ""

strCellData = ActiveCell.Value
ActiveCell.Value = strCellData
ActiveCell.Offset(1, 0).Select

'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="",
SubAddress:="'0'!A1", TextToDisplay:="www.puritan.com"
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="http:\\" &
Selection.Value, TextToDisplay:=Selection.Value
Loop

End Sub

End Sub


--
anilsolipuram
------------------------------------------------------------------------
anilsolipuram's Profile: http://www.excelforum.com/member.php...o&userid=16271
View this thread: http://www.excelforum.com/showthread...hreadid=380674