Auto hyperlink creator thingy

[jamienwood]

i have this code to cope a sheet then save it, supposidly as the name you write but infact it doesnt, then its meant to creat a hyperlink to that file and it doesn't quite do that either any surgestions?Sub MAC2()

Dim bookname
bookname = InputBox("Enter New Book Name")

Sheets("sheet1").Select
Sheets("sheet1").Copy
ActiveWorkbook.SaveAs Filename:="C:\" & (bookname) & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Windows("original book2.xls").Activate
Range("a2").Select
' Hyper Link
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="C:\" & (bookname) & ".xls", _
TextToDisplay:=(bookname)
End Sub

[robfo0]

hmm...this code works fine. what are you trying to copy though? it copys the sheet with this code:

Sheets("sheet1").Select
Sheets("sheet1").Copy

but doesnt paste it anywhere? is there more to this? I tried it, and if you have a book called "original book2" open, it does work...what exactly are you trying to accomplish? are you trying to paste the sheet somewhere? another question: what books do you have open to start with? I think maybe you just need to mod this code to do exactly what you want, but it does work.

Ps: you also may want to change:

Range("a2").Select

to :

Range("A65536").End(xlUp).Offset(1, 0).Select

This will put the hyperlink in the last available cell in column A so it doesnt overwrite previous entries (assuming you are inputting multiple)

[ This Message was edited by: robfo0 on 2002-04-15 15:12 ]

[jamienwood]

I have a system for making up qoutes, i have a worksheet with a customer database and a worksheet for quotes i have got this code for saving the quote and i know this one works, it saves the quote as the custermer reference, but i wanted to add to the code so as it saves it as the reference as a hyperlink on the customer database hes the saving bit:
Sub Quote_Save()
' Macro recorded 3/8/2002 by Jamie Wood
Range("B6:I26").Select
Selection.Copy
Workbooks.Add
Range("B6").Select
ActiveSheet.Paste
Columns("B:B").ColumnWidth = 8.57
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").ColumnWidth = 8.29
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("F:F").ColumnWidth = 31.43
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").ColumnWidth = 12.43
Rows("20:20").RowHeight = 15
Rows("20:20").RowHeight = 15.75
Rows("24:24").RowHeight = 19.5
Range("C2:F2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
Selection.Font.Bold = True
Selection.Font.Underline = xlUnderlineStyleSingle
ActiveCell.FormulaR1C1 = "Customer Quote"
Range("C3").Select
ActiveWindow.DisplayGridlines = False
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Quote"
Range("B6:I26").Select
Selection.Interior.ColorIndex = xlNone
Range("G26:I26").Select
Selection.Font.ColorIndex = 2
ThisFile2002 = Range("B7").Value
ActiveWorkbook.SaveAs Filename:=ThisFile2002
ActiveWorkbook.Close
Application.Run "Quote_Print"
End Sub