Add New Sheets And Name Them Dynamically
Frequently, it is necessary to add new sheets from VBA. This illustration shows how to insert them in the correct location and rename them.
Simple Example Program Code
Option Explicit
Option Base 1
Public Sub AddSheetsDynamically()
Dim strSalesRepName(5) As String
Dim i As Integer
' ********************************************************
' This Array Could Have Been Loaded in One Statement
' If Loading From A Worksheet Range
' ********************************************************
strSalesRepName(1) = "Joe"
strSalesRepName(2) = "Mary"
strSalesRepName(3) = "Sam"
strSalesRepName(4) = "Beth"
strSalesRepName(5) = "Linda"
' ********************************************************
' Add 5 New Sales Rep Sheets, Rename Them and
' Keep Them In Order
' ********************************************************
For i = 1 To 5
ThisWorkbook.Sheets(Sheets.Count).Activate
ThisWorkbook.Sheets.Add
ThisWorkbook.Sheets(ActiveSheet.Name).Name = strSalesRepName(i)
Next i
Sheets(1).Select
End Sub
Full Example of Creating Worksheets Dynamically
The following code starts with a single fully populated worksheet in alpha order, and separates data from each state to a new worksheet dynamically. It uses a preformatted template for the new sheets. Starting at the top of the primary worksheet, it scans down until it finds the next state, then it moves the previous state to a newly created worksheet.
Option Explicit
Public Sub CreateRepsByState()
Dim strLastState As String
Dim varStateName As Variant
Dim wkbSalesByState As Workbook
Dim wksSalesByState As Worksheet
Dim wksStates As Worksheet
Dim wksCurrentWorksheet As Worksheet
Dim lngBeginningRow As Long
Dim lngEndingRow As Long
Dim lngSheetNumber As Long
Dim rngRowsToCopy As Range
Dim wksSheetAdded As Worksheet
Dim rngStateAbbreviations As Range
Dim i As Long
Set wkbSalesByState = ThisWorkbook
Set wksSalesByState = wkbSalesByState.Sheets("SalesSince2017")
Set wksStates = wkbSalesByState.Sheets("Abbreviations")
Set rngStateAbbreviations = Range(wksStates.Cells(1, 1), wksStates.Cells(52, 2))
strLastState = wksSalesByState.Cells(3, "G")
lngBeginningRow = 3
Application.ScreenUpdating = False
For i = 3 To 2113
If wksSalesByState.Cells(i, "G") <> strLastState Then
' *************************************************************
' Copy the Template And Rename It
' *************************************************************
lngEndingRow = i - 1
wkbSalesByState.Sheets("SalesTemplate").Copy After:=Worksheets(Worksheets.Count)
' ****************************************************************
' Vlookup Parameters
' (1) The Value You Are Looking For
' (2) The Range Of The Values Table You Are Searching
' (3) The Column Number of the Value Table That Contains the "Answer"
' (4) False - Find An Exact Match - Value Table Does Not Need To Be
' In Order
' ****************************************************************
On Error Resume Next
varStateName = Application.WorksheetFunction.VLookup(strLastState, rngStateAbbreviations, 2, False)
If Err.Number = 1004 Or Err.Number = 438 Then
Err.Clear
varStateName = strLastState & "-" & "Error"
Else
varStateName = strLastState & "-" & varStateName
End If
ActiveSheet.Name = varStateName
' *************************************************************
' Copy Data
' *************************************************************
Set rngRowsToCopy = Range(wksSalesByState.Cells(lngBeginningRow, 1), wksSalesByState.Cells(lngEndingRow, "K"))
rngRowsToCopy.Copy
Range("A3").Select
ActiveSheet.Paste
Range("A1").Select
lngBeginningRow = i
strLastState = wksSalesByState.Cells(i, "G")
End If
Next i
' *************************************************************
' Populate the Last State
' *************************************************************
' *************************************************************
' Copy the Template And Rename It
' *************************************************************
lngEndingRow = i
wkbSalesByState.Sheets("SalesTemplate").Copy After:=Worksheets(Worksheets.Count)
' ****************************************************************
' Vlookup Parameters
' (1) The Value You Are Looking For
' (2) The Range Of The Values Table You Are Searching
' (3) The Column Number of the Value Table That Contains the "Answer"
' (4) False - Find An Exact Match - Value Table Does Not Need To Be
' In Order
' ****************************************************************
On Error Resume Next
varStateName = Application.WorksheetFunction.VLookup(strLastState, rngStateAbbreviations, 2, False)
If Err.Number = 1004 Or Err.Number = 438 Then
Err.Clear
varStateName = strLastState & "-" & "Error"
Else
varStateName = strLastState & "-" & varStateName
End If
ActiveSheet.Name = varStateName
' *************************************************************
' Copy Data
' *************************************************************
Set rngRowsToCopy = Range(wksSalesByState.Cells(lngBeginningRow, 1), wksSalesByState.Cells(lngEndingRow, "K"))
rngRowsToCopy.Copy
Range("A3").Select
ActiveSheet.Paste
Range("A1").Select
wksSalesByState.Activate
wksSalesByState.Select
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub
