Text Functions‎ > ‎

Create Sheets

"I have an INDEX sheet at the beginning of a workbook with a bunch of values in column A. 
Can I quickly create new sheets named for the values on my INDEX and add hyperlinks like a table of contents?"

  1. Values are listed in a column, easily editable (code is colored in red below for the range of cells, starts in A2 in this example)
  2. Sheets might already exist to some extent
  3. Sheets need to be created
  4. Resulting sheets should be in the same order as the list
  5. Hyperlinks are created on the main sheet to jump to the individual sheets
  6. A Hyperlink is added to each individual sheet in cell A1 to jump back to the index
                SAMPLE FILE   -   CreateSheets.xls


Option Explicit

Sub CreateSheets()
'Author:    Jerry Beaucaire
'Date:      7/14/2010
'Summary:   Use an index table to create/sort sheets in a workbook with hyperlinks

Dim RNG As Range
Dim c As Range
Application.ScreenUpdating = False

'Set list of sheetnames
    Set RNG = ActiveSheet.Range("A2:A" & Rows.Count).SpecialCells(xlConstants)

For Each c In RNG
  'test if the sheet exists already
    If Not Evaluate("ISREF('" & c.Text & "'!A1)") Then
      'Create it if it doesn't exist
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = c.Text
      'Move it to the correct spot if it already exists
        Sheets(c.Text).Move After:=Sheets(Sheets.Count)
    End If
  'add hyperlink on new sheet to get back to INDEX page
    Sheets(c.Text).Range("A1").Formula = "=HYPERLINK(""#Index!A1"",""Home"")"
  'add hyperlink on INDEX to new sheet
    c.Offset(, 1).FormulaR1C1 = "=HYPERLINK(""#'"" & RC[-1] & ""'!A1"", ""Link"")"
Next c

Application.ScreenUpdating = True
End Sub

Nothing says "thanks" like a steak dinner!
PayPal - The safer, easier way to pay online!