VBA for Creating Excel Sheets from a Template with Data Mapping
v20250625
Sub CreateSheetsFromTemplate()Dim sourceSheet As WorksheetDim templateSheet As WorksheetDim newSheet As WorksheetDim newSheetName As StringDim cellValueA As StringDim cellValueJ As StringDim i As Integer' Set error handlingOn Error Resume Next' Get the source worksheet ("Member List")Set sourceSheet = ThisWorkbook.Worksheets("Member List")' Exit if source worksheet not foundIf sourceSheet Is Nothing ThenMsgBox "Cannot find worksheet 'Member List'! Please ensure the worksheet exists.", vbExclamation, "Error"Exit SubEnd If' Get the template worksheetSet templateSheet = ThisWorkbook.Worksheets("template")' Exit if template worksheet not foundIf templateSheet Is Nothing ThenMsgBox "Cannot find worksheet 'template'! Please ensure the template worksheet exists.", vbExclamation, "Error"Exit SubEnd If' Process 5 rows starting from A4For i = 4 To 8' Get values from cells A(i) and J(i)cellValueA = sourceSheet.Range("A" & i).ValuecellValueJ = sourceSheet.Range("J" & i).Value' Check if A column cell is emptyIf cellValueA = "" ThenMsgBox "Cell A" & i & " in Member List worksheet is empty, skipping this row.", vbInformation, "Notice"Else' Create new worksheet name using the A column value, limited to 31 charactersnewSheetName = Left(cellValueA, 31)' Check for illegal characters in worksheet nameIf InStr(newSheetName, "?") > 0 Or InStr(newSheetName, "/") > 0 Or InStr(newSheetName, "\") > 0 Or _InStr(newSheetName, "*") > 0 Or InStr(newSheetName, "[") > 0 Or InStr(newSheetName, "]") > 0 Or _InStr(newSheetName, ":") > 0 Or InStr(newSheetName, "'") > 0 Then' Replace illegal characters with underscoresnewSheetName = Replace(newSheetName, "?", "_")newSheetName = Replace(newSheetName, "/", "_")newSheetName = Replace(newSheetName, "\", "_")newSheetName = Replace(newSheetName, "*", "_")newSheetName = Replace(newSheetName, "[", "_")newSheetName = Replace(newSheetName, "]", "_")newSheetName = Replace(newSheetName, ":", "_")newSheetName = Replace(newSheetName, "'", "_")End If' Check if a worksheet with the same name already existsDim sheetExists As BooleansheetExists = FalseFor Each sht In ThisWorkbook.WorksheetsIf sht.Name = newSheetName ThensheetExists = TrueExit ForEnd IfNext shtIf sheetExists Then' If worksheet already exists, ask if user wants to replace itDim response As Integerresponse = MsgBox("Worksheet '" & newSheetName & "' already exists. Do you want to replace it?", vbYesNo + vbQuestion, "Worksheet Already Exists")If response = vbYes ThenApplication.DisplayAlerts = FalseThisWorkbook.Worksheets(newSheetName).DeleteApplication.DisplayAlerts = TrueElse' User chose not to replace, continue to next iterationGoTo NextIterationEnd IfEnd If' Copy template worksheet and rename ittemplateSheet.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)Set newSheet = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)newSheet.Name = newSheetName' Set cell B3 content to the value from column AnewSheet.Range("B3").Value = cellValueA' Set cell F2 content to the value from column JnewSheet.Range("F2").Value = cellValueJ' Log success messageDebug.Print "Created worksheet: " & newSheetName & ", filled B3=" & cellValueA & ", F2=" & cellValueJEnd IfNextIteration:Next i' Reset error handlingOn Error GoTo 0MsgBox "Operation completed! New worksheets have been created from rows A4-A8 of the Member List worksheet.", vbInformation, "Completed"
End Sub
Using VBA to Automate Sheet Creation from Templates in Excel
Introduction
In today’s data-driven workplace, Excel remains a powerhouse for organizing and analyzing information. One common requirement is creating multiple sheets with the same structure but different data - perfect for reports, member profiles, or product sheets. While this can be done manually, automation through VBA (Visual Basic for Applications) can save hours of repetitive work.
This blog post introduces a powerful VBA solution that creates multiple worksheets from a template, automatically mapping data from a source sheet to specific locations in each new sheet.
The Business Problem
Imagine you have a “Member List” worksheet with multiple rows of data. For each member, you need to create a separate worksheet with a standardized layout. You want:
- Each new sheet to be named after the member (from column A)
- Member information to be copied to specific cells in the new sheet
- The process to be automated for multiple members at once
Manually, this would involve copying your template sheet multiple times, renaming each copy, and then copy-pasting data to the right cells - a tedious and error-prone process.
The VBA Solution
Our solution uses VBA to automate this entire workflow. The code:
- Uses a template worksheet as the foundation for each new sheet
- Processes 5 rows of data starting from cell A4 in the “Member List” sheet
- Creates a new sheet for each row, naming it based on the value in column A
- Copies values from columns A and J to cells B3 and F2 in each new sheet
- Handles errors and edge cases gracefully
How It Works
Preparation
Before running the code, you need:
- A worksheet named “Member List” containing your source data
- A worksheet named “template” with your desired layout
- Data in columns A and J of the “Member List” sheet, starting from row 4
Code Walkthrough
Let’s break down how the code works:
1. Setting Up
Dim sourceSheet As Worksheet
Dim templateSheet As Worksheet
Dim newSheet As Worksheet
These variables store references to our worksheets - the source data, the template, and each newly created sheet.
2. Error Checking
' Get the source worksheet ("Member List")
Set sourceSheet = ThisWorkbook.Worksheets("Member List")' Exit if source worksheet not found
If sourceSheet Is Nothing ThenMsgBox "Cannot find worksheet 'Member List'! Please ensure the worksheet exists.", vbExclamation, "Error"Exit Sub
End If
This section ensures that both required worksheets exist before proceeding.
3. Processing Each Row
' Process 5 rows starting from A4
For i = 4 To 8' Get values from cells A(i) and J(i)cellValueA = sourceSheet.Range("A" & i).ValuecellValueJ = sourceSheet.Range("J" & i).Value' Check if A column cell is emptyIf cellValueA = "" ThenMsgBox "Cell A" & i & " in Member List worksheet is empty, skipping this row.", vbInformation, "Notice"Else' Code to create and populate sheetEnd If
Next i
We loop through rows 4-8, extracting values from columns A and J. Empty cells in column A are skipped.
4. Sheet Naming and Validation
' Create new worksheet name using the A column value, limited to 31 characters
newSheetName = Left(cellValueA, 31)' Check for illegal characters in worksheet name
If InStr(newSheetName, "?") > 0 Or InStr(newSheetName, "/") > 0 Or InStr(newSheetName, "\") > 0 Or _InStr(newSheetName, "*") > 0 Or InStr(newSheetName, "[") > 0 Or InStr(newSheetName, "]") > 0 Or _InStr(newSheetName, ":") > 0 Or InStr(newSheetName, "'") > 0 Then' Replace illegal characters with underscores' [replacement code]
End If
Excel has strict rules for sheet names - they must be 31 characters or less and cannot contain certain special characters. Our code handles these limitations automatically.
5. Creating the New Sheet
' Copy template worksheet and rename it
templateSheet.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Set newSheet = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
newSheet.Name = newSheetName
Here we clone the template sheet and assign it the new name.
6. Data Mapping
' Set cell B3 content to the value from column A
newSheet.Range("B3").Value = cellValueA' Set cell F2 content to the value from column J
newSheet.Range("F2").Value = cellValueJ
This is where the magic happens - we map specific data from our source sheet to predefined locations in the new sheet.
Customization Options
The code is highly adaptable to your specific needs:
Processing More or Fewer Rows
Change the loop range:
' Process 10 rows instead of 5
For i = 4 To 13
Mapping Additional Fields
Add more mappings by extracting additional columns:
cellValueB = sourceSheet.Range("B" & i).Value
cellValueC = sourceSheet.Range("C" & i).Value' Later in the code:
newSheet.Range("C5").Value = cellValueB
newSheet.Range("D10").Value = cellValueC
Different Naming Convention
Use a different naming pattern:
' Use format "Member - [Name]"
newSheetName = "Member - " & Left(cellValueA, 20)
