top of page

Module_05_Sheets

Copy and paste the below into a module in VBA

Sub Sheet_Add()

'Add a Sheet to the active workbook

     

    Sheets.Add

     

End Sub

'--------------------------------------------------------------------------

 

Sub Sheet_Add_named()

'Add a named Sheet to the active workbook

     

    Sheets.Add.Name = "test"

     

    'add named sheet before active sheet

    'Sheets.Add(, ActiveSheet).Name = "test"

 

End Sub

'--------------------------------------------------------------------------

 

Sub Sheet_rename()

'Rename the active Sheet to the value of the active cell

     

    ActiveSheet.Name = ActiveCell.Value

 

End Sub

'--------------------------------------------------------------------------

 

Sub Sheet_select()

'Selects Sheet1

 

    Sheets("Sheet1").Select

     

End Sub

'--------------------------------------------------------------------------

 

Sub Sheet_delete()

'Delete Sheet called "TEMP" with no alerts

 

    Application.DisplayAlerts = False

    On Error Resume Next

    Worksheets("TEMP").Delete

    Application.DisplayAlerts = True

 

End Sub

'--------------------------------------------------------------------------

 

Sub Sheet_color_blue()

'Blue Sheet

 

    'ActiveWorkbook.ActiveSheet.Tab.ColorIndex = xlAutomatic

 

    With ActiveWorkbook.ActiveSheet.Tab

        .Color = 12611584 'blue

'        .Color = 255 'red

'        .Color = 5287936 'green

'        .Color = 65535 'yellow

'        .Color = 10498160 'purple

 

    End With

End Sub

'--------------------------------------------------------------------------

 

Sub Sheet_color_red()

'Red Sheet

 

    ActiveSheet.Tab.ColorIndex = 3 'xlColorIndexNone

    '3=Red , 4=green,5=blue,6=yellow,etc...

 

End Sub

'--------------------------------------------------------------------------

 

Sub Sheet_RemoveTabColor()

'Remove tab color from worksheet

 

'Specific Tab

  'ThisWorkbook.Worksheets("Sheet1").Tab.ColorIndex = xlColorIndexNone

   

'Active Tab

  ActiveSheet.Tab.ColorIndex = xlColorIndexNone

     

End Sub

'--------------------------------------------------------------------------

 

Sub Sheet_Count_Sheets()

'Counts how may sheets exist in the active workbook

 

    MsgBox ActiveWorkbook.Sheets.Count

 

End Sub

'--------------------------------------------------------------------------

 

Sub Add_40_sheets()

 

    For i = 1 To 40

        Sheets.Add

    Next i

 

End Sub

'--------------------------------------------------------------------------

 

Sub Selection_to_new_sheets()

'Create a new Sheet named as each selected cell

    Set a = ActiveSheet

    For Each cell In Selection

        Sheets.Add(, ActiveSheet).Name = cell

    Next cell

    a.Select

End Sub

'--------------------------------------------------------------------------

 

Sub Sheet_Exists()

'check if Sheet Index exists

 

    sName = "Sheet index"

    MsgBox Evaluate("ISREF('" & sName & "'!A1)")

     

End Sub

'--------------------------------------------------------------------------

 

Sub HyperLink_SheetsToIndex()

'Adds a sheet as index to all sheets.

'The SheetSelector would be the best option

 

    'check if Sheet Index exists, and if not, create it

    sName = "Sheet index"

    If Evaluate("ISREF('" & sName & "'!A1)") = True Then

        Sheets("Sheet Index").Select

    Else

        Sheets.Add.Name = "Sheet Index"

        Sheets("Sheet Index").Select

    End If

 

    'Clear all in column A

    Worksheets("Sheet Index").Range("A:A").ClearContents

     

    'Loop through all worksheets

    For i = 1 To ActiveWorkbook.Sheets.Count

         

        'Enter name of sheet to column A

        Cells(i, 1).Value = ActiveWorkbook.Sheets(i).Name

         

        'Create Hyperlink

        strSubAddress = "'" & ActiveWorkbook.Sheets(i).Name & "'!A1"

        strDisplayText = "" & ActiveWorkbook.Sheets(i).Name

        Worksheets("Sheet Index").Hyperlinks.Add Anchor:=Cells(i, 1), Address:="", SubAddress:=strSubAddress, TextToDisplay:=strDisplayText

 

    Next i

 

End Sub

'--------------------------------------------------------------------------

 

Sub HyperLink_SheetsToIndex_OLD()

'Adds a sheet as index to all sheets.

'The SheetSelector would be the best option

 

    Dim wks                 As Worksheet

    Dim rngLinkCell         As Range

    Dim strSubAddress       As String, strDisplayText       As String

 

    Sheets.Add

    ActiveSheet.Name = "Sheet Index"

 

    'Loop through all worksheets

    'Clear all current hyperlinks

    Worksheets("Sheet Index").Range("A:A").ClearContents

    For Each wks In ActiveWorkbook.Worksheets

        Set rngLinkCell = Worksheets("Sheet Index").Range("A65536").End(xlUp)

        If rngLinkCell <> "" Then Set rngLinkCell = rngLinkCell.Offset(1, 0)

        strSubAddress = "'" & wks.Name & "'!A1"

        strDisplayText = "HyperLink : " & wks.Name

        Worksheets("Sheet Index").Hyperlinks.Add Anchor:=rngLinkCell, Address:="", SubAddress:=strSubAddress, TextToDisplay:=strDisplayText

    Next wks

 

End Sub

STAY IN TOUCH

Send me an email at:

Join our mailing list

Will not spam, Will not sell !!!

bottom of page