Auto Increase Hyperlink Reference

Urlord

Board Regular
Joined
Aug 5, 2010
Messages
130
Is it possible to autofill a hyper link reference in a worksheet.?

Example

A
1 sheet1
2 sheet2
3 sheet3

etc.

And one more question if you don't mind.
Is it possble to auto create new worksheets that areidentical to to previous and automaticall rename it

Example
sheet30 = 030-cs
I would like to automatically increase the of series of worksheets that would automatically be renamed 031-CS 032-CS 033-CS ETC

Thanks
 

Some videos you may like

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

Misca

Well-known Member
Joined
Aug 12, 2009
Messages
1,674
Here's a simple code that should be easy to edit to match your needs:
Code:
Sub CopySheetMenu()

Dim MenuSheet As Worksheet
Dim TemplateSheet As Worksheet
Dim WS As Worksheet
Dim c As Range

Application.ScreenUpdating = False

Set MenuSheet = ActiveSheet     'This is the sheet where you want to place your hyperlinks
Set c = MenuSheet.Range("A1")

Set TemplateSheet = Sheet2   'This is the sheet to be duplicated

'Copies the TemplateSheet after all the existing sheets:
TemplateSheet.Copy after:=Sheets(Sheets.Count)

'Names the new wheet and clears the given range:
With ActiveSheet
    .Name = Right("00" & Sheets.Count, 3) & "-CS"
    .Range("A1:B2,D3:H4").Value = ""
End With

'Clears the existing Menu (=to make sure it's up to date / all the sheets still exist):
MenuSheet.Range("A1:A" & Rows.Count).Clear

'Makes the new Menu:
For Each WS In Worksheets

'Skips the MenuSheet and the TemplateSheet from the hyperlinks-menu:
    If WS.Name <> MenuSheet.Name And WS.Name <> TemplateSheet.Name Then
        MenuSheet.Hyperlinks.Add anchor:=c, Address:="", SubAddress:="'" & WS.Name & "'!A1", TextToDisplay:=WS.Name
        Set c = c.Offset(1, 0)
    End If

'Goes back to MenuSheet:
MenuSheet.Activate

Next WS

End Sub
 
Last edited:

Urlord

Board Regular
Joined
Aug 5, 2010
Messages
130
Here's a simple code that should be easy to edit to match your needs:
Code:
Sub CopySheetMenu()
 
Dim MenuSheet As Worksheet
Dim TemplateSheet As Worksheet
Dim WS As Worksheet
Dim c As Range
 
Application.ScreenUpdating = False
 
Set MenuSheet = ActiveSheet     'This is the sheet where you want to place your hyperlinks
Set c = MenuSheet.Range("A1")
 
Set TemplateSheet = Sheet2   'This is the sheet to be duplicated
 
'Copies the TemplateSheet after all the existing sheets:
TemplateSheet.Copy after:=Sheets(Sheets.Count)
 
'Names the new wheet and clears the given range:
With ActiveSheet
    .Name = Right("00" & Sheets.Count, 3) & "-CS"
    .Range("A1:B2,D3:H4").Value = ""
End With
 
'Clears the existing Menu (=to make sure it's up to date / all the sheets still exist):
MenuSheet.Range("A1:A" & Rows.Count).Clear
 
'Makes the new Menu:
For Each WS In Worksheets
 
'Skips the MenuSheet and the TemplateSheet from the hyperlinks-menu:
    If WS.Name <> MenuSheet.Name And WS.Name <> TemplateSheet.Name Then
        MenuSheet.Hyperlinks.Add anchor:=c, Address:="", SubAddress:="'" & WS.Name & "'!A1", TextToDisplay:=WS.Name
        Set c = c.Offset(1, 0)
    End If
 
'Goes back to MenuSheet:
MenuSheet.Activate
 
Next WS
 
End Sub

Great code.
Is there a way to set a range for the macro to automatically create. As it is, it will only create one link and worksheet at a time. Would it be possible to have the macro create 2000 and then stop?

Thanks
 
Last edited:

Misca

Well-known Member
Joined
Aug 12, 2009
Messages
1,674

ADVERTISEMENT

You want the macro to create 2000 new sheets at once?
Code:
Sub CopySheetMenu()

Dim MenuSheet As Worksheet
Dim TemplateSheet As Worksheet
Dim WS As Worksheet
Dim c As Range
Dim i As Long

Application.ScreenUpdating = False

Set MenuSheet = ActiveSheet     'This is the sheet where you want to place your hyperlinks
Set c = MenuSheet.Range("A1")

Set TemplateSheet = Sheet2   'This is the sheet to be duplicated

For i = 1 To 20 'adjust the number to match the number of sheets you want to create

'Copies the TemplateSheet after all the existing sheets:
TemplateSheet.Copy after:=Sheets(Sheets.Count)

'Names the new wheet and clears the given range:
With ActiveSheet
    .Name = Right("00" & Sheets.Count, 3) & "-CS"
    .Range("A1:B2,D3:H4").Value = ""
End With

Next i

'Clears the existing Menu (=to make sure it's up to date / all the sheets still exist):
MenuSheet.Range("A1:A" & Rows.Count).Clear

'Makes the new Menu:
For Each WS In Worksheets

'Skips the MenuSheet and the TemplateSheet from the hyperlinks-menu:
    If WS.Name <> MenuSheet.Name And WS.Name <> TemplateSheet.Name Then
        MenuSheet.Hyperlinks.Add anchor:=c, Address:="", SubAddress:="'" & WS.Name & "'!A1", TextToDisplay:=WS.Name
        Set c = c.Offset(1, 0)
    End If

'Goes back to MenuSheet:
MenuSheet.Activate

Next WS

End Sub
 

Urlord

Board Regular
Joined
Aug 5, 2010
Messages
130
You want the macro to create 2000 new sheets at once?
Code:
Sub CopySheetMenu()
 
Dim MenuSheet As Worksheet
Dim TemplateSheet As Worksheet
Dim WS As Worksheet
Dim c As Range
Dim i As Long
 
Application.ScreenUpdating = False
 
Set MenuSheet = ActiveSheet     'This is the sheet where you want to place your hyperlinks
Set c = MenuSheet.Range("A1")
 
Set TemplateSheet = Sheet2   'This is the sheet to be duplicated
 
For i = 1 To 20 'adjust the number to match the number of sheets you want to create
 
'Copies the TemplateSheet after all the existing sheets:
TemplateSheet.Copy after:=Sheets(Sheets.Count)
 
'Names the new wheet and clears the given range:
With ActiveSheet
    .Name = Right("00" & Sheets.Count, 3) & "-CS"
    .Range("A1:B2,D3:H4").Value = ""
End With
 
Next i
 
'Clears the existing Menu (=to make sure it's up to date / all the sheets still exist):
MenuSheet.Range("A1:A" & Rows.Count).Clear
 
'Makes the new Menu:
For Each WS In Worksheets
 
'Skips the MenuSheet and the TemplateSheet from the hyperlinks-menu:
    If WS.Name <> MenuSheet.Name And WS.Name <> TemplateSheet.Name Then
        MenuSheet.Hyperlinks.Add anchor:=c, Address:="", SubAddress:="'" & WS.Name & "'!A1", TextToDisplay:=WS.Name
        Set c = c.Offset(1, 0)
    End If
 
'Goes back to MenuSheet:
MenuSheet.Activate
 
Next WS
 
End Sub

Yes I meant 2000. I get a 400 error after it reaches 1000. It actually names 1000 as 000 then name 1001 as 001(2) then I get the 400 error and no links are created after the error
 

Misca

Well-known Member
Joined
Aug 12, 2009
Messages
1,674
The error message comes from the renaming of the sheets: It only takes the 3 last characters and when the number is 1000, the 3 last characters are the same as in the beginning. Fix the naming part (either using the If-then -or just by skipping the 3 last characters limit) and it should work.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,143
Messages
5,599,975
Members
414,354
Latest member
Flaxarn

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top