Function To Get The Selected Sheet Names With Examples
Function to get the selected sheet names with examples.
- Create a string from sheet names separates by a forward slash - “/” this character is not allowed to be used in a sheet name.
- Use this with the ExtractWord function to get a list of the selected sheets in the active workbook.
- Then iterate through each selected sheet and copy to a new workbook.
Looping through each sheet means you can test for any protected sheets in the selection. The most popular use of copying to another workbook is ‘ActiveWindow.SelectedSheets.Copy’ however this an error if any of the selected sheets contains a table.
'==========================================================================================================
' ## Function: create a string from sheet names separates by a forward slash - "/"
' as this character is not allowed to be used in a sheet name. Use this with the
' ExtractWord function to get a list of the selected sheets in the active workbook.
' Then iterate through each selected sheet and copy to a new workbook. This way you
' can test for any protected sheets in the selection. The most popular use of copying
' sheets to another workbook is 'ActiveWindow.SelectedSheets.Copy' however this
' throws an error if any of the selected sheets contains a table.
'==========================================================================================================
Function SelectedSheetNames()
' Vars
Dim SheetList As String
Dim shtName As Worksheet
' Create a string with sheets joined
For Each shtName In ActiveWindow.SelectedSheets
SheetList = SheetList & shtName.Name & "/"
Next shtName
' Output the list and take off the last forward slash
SelectedSheetNames = Left(SheetList, Len(SheetList) - 1)
End Function
'==========================================================================================================
' # Test the 'Selected Sheet Names' Function
Sub ListSelectedSheets()
MsgBox SelectedSheetNames
End Sub
'==========================================================================================================
' # Loop through each selected sheet
Sub LoopSelectedSheetsExample1()
' Vars
Dim i As Long
Dim arr() As String
' Loop through each selected sheet and msgbox each sheet name
For i = 0 To ActiveWindow.SelectedSheets.Count - 1
arr = VBA.Split(SelectedSheetNames, "/")
MsgBox arr(i)
Next
End Sub
'==========================================================================================================
' # Same as example 1 but using the ExtractWord function
Sub LoopSelectedSheetsExample2()
' Vars
Dim i As Long
Dim arr() As String
' Loop through each selected sheet and msgbox each sheet name
For i = 1 To ActiveWindow.SelectedSheets.Count
MsgBox ExtractWord(SelectedSheetNames, i)
Next
End Sub
'==========================================================================================================
' # Loop through each selected sheet and rename them
Sub LoopSelectedSheetsExample3()
' Vars
Dim i As Long
Dim SelectedCount As Long
Dim SheetNames As String
' Optimise
Application.ScreenUpdating = False
' Get count of selected sheets as will have to deselect before copying
' If count is 1 then rename this one then exit
SelectedCount = ActiveWindow.SelectedSheets.Count
If SelectedCount = 1 Then
ActiveSheet.Name = "RenamedSheet-1"
Exit Sub
End If
' Get the list of sheet names
SheetNames = SelectedSheetNames
' Select only the active sheet
ActiveSheet.Select
' Loop through each selected sheet and copy to a new workbook
For i = 1 To SelectedCount
Sheets(ExtractWord(SheetNames, i)).Name = "RenamedSheet-" & i
Next
' Optimise
Application.ScreenUpdating = True
End Sub
'==========================================================================================================
' # Loop through each selected sheet and copy to new workbook
Sub LoopSelectedSheetsExample4()
' Vars
Dim i As Long
Dim SelectedCount As Long
Dim SheetNames As String
Dim wbOriginal As Workbook
Dim wbNew As Workbook
' Optimise
Application.ScreenUpdating = False
' Get count of selected sheets as will have to deselect before copying
' If count is 1 then copy this one then exit
SelectedCount = ActiveWindow.SelectedSheets.Count
If SelectedCount = 1 Then
ActiveWorkbook.ActiveSheet.Copy
Set wbNew = ActiveWorkbook
Exit Sub
End If
Set wbOriginal = ActiveWorkbook
' Get the list of sheet names
SheetNames = SelectedSheetNames
' Select only the active sheet
ActiveSheet.Select
' Loop through each selected sheet and copy to a new workbook
For i = 1 To SelectedCount
If i = 1 Then
wbOriginal.Sheets(ExtractWord(SheetNames, i)).Copy
Set wbNew = ActiveWorkbook
Else
wbOriginal.Sheets(ExtractWord(SheetNames, i)).Copy After:=wbNew.Sheets(Sheets.Count)
End If
Next
' Optimise
Application.ScreenUpdating = True
End Sub