I'm new to VBA but I'm not new to scripting languages. I have a problem with setting a worksheet variable for some reason in this routine. The same syntax works in other routines but for some reason it won't in this one.
Can someone explain why my worksheet variable 'wks' will NOT populate? I'm not getting any errors but it will not populate. It remains empty.
The problem is this line "Set wks = .Sheets(strTemplate)". The variable 'strTemplate', when mousing over it DOES indicate the proper template sheet name but the worksheet variable 'wks' never populates.
Here's the subroutine that creates a copy of a template sheet, then renames it in order to be populated with data from the 'Main' sheet. I even put in 'Debug' commands but the one that prints "Sheet =" never executes due to 'wks' being empty.
' REPLACE MAIN WORKSHEET AFTER COPYING
'
Public Sub SheetReplace(strSheetName As String, strTemplate As String)
Dim wks As Worksheet
Debug.Print "Entered SheetReplace"
' We don't want screen updating
Application.ScreenUpdating = False
' Delete the existing Main - Copy if it exists
Application.DisplayAlerts = False 'turn off alerts
On Error Resume Next 'continue execution
Worksheets("Main - Copy").Delete 'delete the worksheet
Err.Clear 'clear error
Application.DisplayAlerts = True 'turn on alerts
With ThisWorkbook
' Duplicate the Main - Tmplt sheet
' Duplicate the template sheet
Set wks = .Sheets(strTemplate)
Debug.Print "Sheet = [" & wks & "]"
' Check sheet visibility
isVisible = (wks.Visible = xlSheetVisible)
' Make the sheet visible if not
If Not isVisible Then wks.Visible = xlSheetVisible
' Copy duplicate to the end of the sheets
wks.Copy After:=.Sheets(strSheetName)
' Change the name of the sheet
ActiveSheet.Name = strSheetName & " - Copy"
' Make the sheet invisible
If isVisible Then ws.Visible = xlSheetHidden
' BEGIN COPYING MAIN SHEET INFO
With Worksheets("Main")
Set srcWorkSheet = Worksheets(ActiveSheet.Name) ' Duplicate the Copy name
lastRowMain = .Cells(.Rows.Count, "A").End(xlUp).Row ' Find the last row used in "Main" sheet
' Copy the ranges that contain daily data.
' Copy the Month
.Range("$C$8").Copy Destination:=Worksheets(ActiveSheet.Name).Range("$C$8")
.Range("$I$11").Copy Destination:=Worksheets(ActiveSheet.Name).Range("$I$11")
.Range("$B15:$I51").Copy Destination:=Worksheets(ActiveSheet.Name).Range("$B15:$I51")
srcWorkSheet.Visible = xlSheetHidden ' Make the copy sheet invisible
' Clear cells (including formatting)
.Range("$C15:$H51").ClearContents
End With
' THIS IS THE END OF THE MAIN COPY
End With
End Sub
Any info would be appreciated. Thanks.
Well apparently I had a syntax error & the 'wks' variable WAS being set, I just needed to reference the 'wks.Name' property. Once I did that the execution continued.
Set wks = .Sheets(strTemplate)
Debug.Print "Sheet = [" & wks.Name & "]" <------ OUTPUT: Sheet = [Main - Copy]
#VBasic2008 : Yep. I didn't see your post until now but thanks for responding with that. You've all been a great help.
Update Workbook
Use Option Explicit.
Use ThisWorkbook if you're doing stuff in the workbook containing the code.
On Error Goto 0 turns off error handling (This was the fatal mistake).
A Quick Fix
Option Explicit
Public Sub SheetReplace(strSheetName As String, strTemplate As String)
Dim wb As Workbook
Set wb = ThisWorkbook
' We don't want screen updating
Application.ScreenUpdating = False
' Delete the existing Main - Copy if it exists
On Error Resume Next 'continue execution
Application.DisplayAlerts = False 'turn off alerts
wb.Worksheets("Main - Copy").Delete 'delete the worksheet
Application.DisplayAlerts = True 'turn on alerts
On Error GoTo 0 'disable error handling
' Duplicate the Main - Tmplt sheet
' Duplicate the template sheet
Dim wks As Worksheet
Set wks = wb.Worksheets(strTemplate)
' Check sheet visibility
Dim isVisible As Boolean
isVisible = (wks.Visible = xlSheetVisible)
' Make the sheet visible if not
If Not isVisible Then
wks.Visible = xlSheetVisible
End If
' Copy duplicate to the end of the sheets
wks.Copy After:=wb.Worksheets(strSheetName)
' Change the name of the sheet
Dim src As Worksheet
Set src = wb.ActiveSheet
src.Name = strSheetName & " - Copy"
' Make the sheet invisible
If isVisible Then wks.Visible = xlSheetHidden
' BEGIN COPYING MAIN SHEET INFO
Dim LastRowMain As Long
With wb.Worksheets("Main")
' Find the last row used in "Main" sheet
LastRowMain = .Cells(.Rows.Count, "A").End(xlUp).Row
' Copy the ranges that contain daily data.
' Copy the Month
.Range("$C$8").Copy Destination:=src.Range("$C$8")
.Range("$I$11").Copy Destination:=src.Range("$I$11")
.Range("$B15:$I51").Copy Destination:=src.Range("$B15:$I51")
' If you only need values, this is more efficient (faster).
'src.Range("$C$8").Value = .Range("$C$8").Value
'src.Range("$I$11").Value = .Range("$I$11").Value
'src.Range("$B15:$I51").Value = .Range("$B15:$I51").Value
' Make the copy sheet invisible
src.Visible = xlSheetHidden
' Clear cells (including formatting)
.Range("$C15:$H51").ClearContents
End With
' THIS IS THE END OF THE MAIN COPY
End Sub
Related
I am running my code trying to loop through old and new formatted workbooks.
And the sheet names in my old workbooks are different from the new workbooks.
The code is set to run when the new workbook's names are found.
The old workbooks have sheets named "01", "02" and "03".
The new workbooks have sheets named "newname01", "newname02" and "03".
The code is set to run to "newname01" and "newname02".
What I need to do is if the code runs through an old workbook, change the old sheet names to the new workbook's sheet names and run the code. And when running through a new workbook, run through it without changing the sheet names.
I tried changing the old workbook's sheet names to the new ones at the beginning of the code. But when the code is running through an old workbook, its sheets don't contain the new names the code shows an error.
I tried using -
If Not______Is Nothing then.
But I couldn't figure out how that code works.
my code--->
Sub CD3()
Dim wb As Workbook
For Each wb In Application.Workbooks
If Not Application.ActiveProtectedViewWindow Is Nothing Then
Application.ActiveProtectedViewWindow.Edit
End If
Sheets("newname01").Select
Range("A8:B10").Orientation = 90
Range("C10:D10").Orientation = 90
Range("E8:F10").Orientation = 90
Range("G10:H10").Orientation = 90
Range("I8:J10").Orientation = 90
Range("K10:N10").Orientation = 90
Range("O8:Q10").Orientation = 90
Range("Q8:Q10").FormulaR1C1 = "Observation/ Proposals"
'List Sheet Adding
Sheets.Add After:=Sheets("newname02")
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "03"
'more code
ActiveWindow.Zoom = 75
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
Range("A11").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
Next ws
End Sub
When the code is running through an old workbook, it has sheets named "01" and "02". I need to change their name to "newname01" and "newname02" and then run the code.
this is a code I found it changed the code regardles of the name
Sub RenameSheet()
Dim Sht As Worksheet
Dim NewSht As Worksheet
Dim newShtName As String
Set NewSht = ActiveSheet
newShtName = "newname01"
For Each Sht In ThisWorkbook.Sheets
If Sht.Name = "newname02" Then
newShtName = "newname01" & "_" &
ThisWorkbook.Sheets.Count
End If
Next Sht
NewSht.Name = newShtName
End Sub
I only need to Change sheet name "01" to "newname01" and "02" to "newname02". And when it already named "newname01" run the rest of the code.
?I tride using -
If Not______Is Nothing then.
I have a feeling that you are not using proper error handling and hence that line or the one before that where you are setting the worksheet is erroring out. Try something like this (UNTESTED)
Option Explicit
Sub Sample()
Dim wbOld As Workbook
Dim wbNew As Workbook
Dim wsOld As Worksheet
Dim wsNew As Worksheet
Dim wsName As String
'~~> Change these two as applicable
Set wbOld = Workbooks("OldWorkBook")
Set wbNew = Workbooks("NewWorkBook")
'~~> Loop through the worksheets in the old workbook
For Each wsOld In wbOld.Worksheets
'~~> Create the name as per new worksheet
'newname01
wsName = "newname" & wsOld.Name
'~~> Attempt to set it. If the worksheet doesn't
'~~> exists, you will not get an error
On Error Resume Next
Set wsNew = wbNew.Sheets(wsName)
On Error GoTo 0
'~~> Check if the object is not nothing
If Not wsNew Is Nothing Then
'~~> Worksheet exists
'
'~~> Do what you want
'
'~~> This is important to prevent false positives
Set wsNew = Nothing
End If
Next wsOld
End Sub
I Wrote two Codes for the two sheet names. The run the code Below
Sub If_Run()
If Not Application.ActiveProtectedViewWindow Is Nothing Then
Application.ActiveProtectedViewWindow.Edit
End If
'Run_for_newname01() = for workbooks containing a Sheet with "newname01"
'Run_for_01() = for workbooks containing a Sheet with "01"
ws = ActiveWorkbook.Worksheets.Count
For i = 1 To ws
With ActiveWorkbook.Worksheets(i)
If .Name Like "*newname01*" Then
Run_for_newname01
ElseIf .Name Like "*01*" Then
Run_for_01
End If
End With
Next i
End Sub
Hi all I had a code in excel vba that makes me able to change sheet name according to cell value i right click on sheet name then select (view code ) then paste the code it worked well with the sheet i did a simple macro that copy the sheet content into another new sheet then paste the code that changes the sheet name with the cell value but i got an error i just need a macro that add new sheet and copy the current sheet content into the new and make the sheet name dependent on cell value (b3)
i have 0 experience in visual basic
here is some screenshots
thanks for helping me
this the sheet name code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B3")) Is Nothing Then
ActiveSheet.Name = ActiveSheet.Range("B3")
End If
End Sub
i have already explained that THAT
Create a Copy of the Active Sheet
Copy this code into a standard module, e.g. Module1.
Option Explicit
Sub CopyActiveSheet()
' In the worst case scenario, you'll end up with an additional worksheet
' that could not be renamed. If you want to keep this worksheet,
' set DeleteIfCannotRename to False.
Const DeleteIfCannotRename As Boolean = True
' Invalidate the active sheet.
Dim sh As Object: Set sh = ActiveSheet
If sh Is Nothing Then Exit Sub ' no visible workbooks open
If Not TypeOf sh Is Worksheet Then Exit Sub ' not a worksheet
' Reference the source worksheet.
Dim sws As Worksheet: Set sws = ActiveSheet
' Create a copy.
sws.Copy After:=sws
' Reference the copy.
Dim dws As Worksheet: Set dws = ActiveSheet
' Write the value form 'B3' to a variable.
Dim dName As String: dName = CStr(dws.Range("B3").Value)
Dim ErrNumber As Long
' Prevent error if a sheet with the same name already exists
' or the value in 'B3' doesn't contain a valid worksheet name.
On Error Resume Next ' turn on error-trapping
' Attempt to rename.
dws.Name = dName
ErrNumber = Err.Number ' store the error number in a variable
On Error GoTo 0 ' turn off error trapping
' Delete and inform. Out-comment or delete the 'MsgBox' line(s)
' if the message box is too annoying.
If DeleteIfCannotRename Then ' will delete
If ErrNumber <> 0 Then
Application.DisplayAlerts = False
dws.Delete
Application.DisplayAlerts = True
MsgBox "Could not rename to '" & dName & "' so it got deleted.", _
vbCritical, "CopyActivesheet"
End If
Else ' will not delete
MsgBox "Could not rename to '" & dName & "'.", _
vbCritical, "CopyActivesheet"
End If
End Sub
I have a workbook with one worksheet Sheet1. On that Sheet I have one table with its default name Table1.
When I copy the worksheet Right-Click > Move or Copy in the same workbook I get sheet Sheet1 (2).
The Table on this sheet is automatically named Table13.
I do some processing in that copied sheet and subsequently remove it. Leaving the workbook with only its original Sheet1.
Each time I make a copy of Sheet1 the table in the copied sheet is incremented by one.
Also if I remove the sheet and add a new one. It keeps incrementing.
I use the workbook and Sheet1 as a template and I create via a macro a lot of copies.
The new Table Name has now Incremented to Table21600.
I found out that Excel will give an overflow when I reach approximately Table21650.
So, I need a way to reset the Name counter of the added table.
Does anyone know how to achieve this?
You can access (and alter) the names of each table ("ListObject") from your macro-code as shown in this example:
Sub ListAllListObjectNames()
Dim wrksheet As Worksheet
Dim lstObjct As ListObject
Dim count As Integer
count = 0
For Each wrksheet In ActiveWorkbook.Worksheets
For Each lstObjct In wrksheet.ListObjects
count = count + 1
lstObjct.Name = "Table_" & CStr(count)
Debug.Print wrksheet.Name, ": ", lstObjct.Name
Next
Next
End Sub
Reset Table 'Counter'
Allthough the 'counter' will not stop incrementing, when you close
the workbook and open it the next time, it will again start from
Table13.
In the Immediate window CRTL+G you will see the table name
before and after the renaming. When done testing just out comment the
lines containing Debug.Print.
The First Code
' Copies a sheet and renames all its tables.
Sub CopySheetWithTable(Optional SheetNameOrIndex As Variant = "Sheet1", _
Optional NewTableName As String = "Tbl")
Dim MySheet As Worksheet
Dim MyCopy As Worksheet
Dim MyTable As ListObject
Dim i As Long
Set MySheet = ThisWorkbook.Worksheets(SheetNameOrIndex)
'MySheet.Copy MySheet ' Before e.g. Sheet1)
MySheet.Copy , MySheet ' After e.g. Sheet1
Set MyCopy = ActiveSheet
For Each MyTable In MyCopy.ListObjects
i = i + 1
Debug.Print "Old Table Name = " & MyTable.Name
MyTable.Name = NewTableName & i
Debug.Print "Old Table Name = " & MyTable.Name
Next
End Sub
Usage
Copy the previous and the following sub into a module. Run the
following sub to copy a new worksheet. Adjust if you want it before
or after the sheet to be copied.
You don't need to copy the worksheet manually anymore.
The Second Code
' You can create a button on the worksheet and use this one-liner in its code.
Sub CopySheet()
CopySheetWithTable ' Default is CopySheetWithTable "Sheet1", "Tbl"
End Sub
Delete all Sheets After Worksheet
This is just a testing tool.
' Deletes all sheets after the selected sheet (referring to the tab order).
Sub DeleteSheetsAfter(DeleteAfterSheetNameOrIndex As Variant) 'Not tested.
Dim LastSheetNumber As Long
Dim SheetsArray() As Variant
Dim i As Long
' Try to find the worksheet in the workbook containing this code.
On Error Resume Next
LastSheetNumber = _
ThisWorkbook.Worksheets(DeleteAfterSheetNameOrIndex).Index
If Err.Number <> 0 Then
MsgBox "There is no Sheet '" & DeleteAfterSheetNameOrIndex & "' " _
& "in (this) workbook '" & ThisWorkbook.Name & "'."
Exit Sub
End If
With ThisWorkbook
ReDim SheetsArray(.Sheets.Count - LastSheetNumber - 1)
For i = LastSheetNumber + 1 To .Sheets.Count
SheetsArray(i - LastSheetNumber - 1) = i
Next
End With
Application.DisplayAlerts = False
ThisWorkbook.Sheets(SheetsArray).Delete
Application.DisplayAlerts = True
MsgBox "Deleted " & UBound(SheetsArray) & " worksheets after worksheet '" _
& ThisWorkbook.Worksheets(DeleteAfterSheetNameOrIndex).Name & "'.", _
vbInformation, "Delete Successful"
End Sub
Sub DeleteAfter()
DeleteSheetsAfter "Sheet1"
End Sub
I have a sheet of raw data that includes vehicle counts over multiple days. Each date is a row representing vehicle counts taken during a 60 minute period (so 24 rows per day).
I have a model that creates a new sheet using the report template for each day. I just can't figure out how to get the actual vehicle count data for each day to populate each sheet for each hour.
Each new tab that is created is named for the date. If we have vehicle counts for 8 day then 8 new tabs would be created. Within that new tab I need to be able to take all 24 vehicle counts and paste them into the template report in the appropriate cells.
Option Explicit
Sub SheetsFromTemplate()
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shDates As Range, Item As Range, NmStr As String
'keep focus in this workbook
With ThisWorkbook
'sheet to be copied
Set wsTEMP = .Sheets("Template")
'check if it's hidden or not
wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)
'make it visible
If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible
'sheet with dates and data
Set wsMASTER = .Sheets("Raw Data")
'range to find names to be checked
Set shDates = wsMASTER.Range("C9:C" & Rows.Count).SpecialCells(xlConstants)
Application.ScreenUpdating = False
'check one data at a time
For Each Item In shDates
NmStr = FixStringForSheetName(CStr(Item.Text))
'if sheet does not exist...
If Not Evaluate("ISREF('" & NmStr & "'!A1)") Then
'...create it from template
wsTEMP.Copy After:=.Sheets(.Sheets.Count)
'...rename it
ActiveSheet.Name = NmStr
End If
Next Item
'return to the master sheet
wsMASTER.Activate
'hide the template if necessary
If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden
'update screen one time at the end
Application.ScreenUpdating = True
End With
MsgBox "All Reports created"
Hard to answer without seeing your worksheets (layout/position of data), but something like the below might give you an idea on how to achieve what you're after.
Option Explicit
Sub SheetsFromTemplate()
Dim templateSheet As Worksheet
Set templateSheet = ThisWorkbook.Worksheets("Template")
Dim originalSheetState As XlSheetVisibility
originalSheetState = templateSheet.Visible
'sheet with dates and data
Dim masterSheet As Worksheet
Set masterSheet = ThisWorkbook.Worksheets("Raw Data")
templateSheet.Visible = xlSheetVisible
Dim lastRowOnMasterSheet As Long
lastRowOnMasterSheet = masterSheet.Cells(masterSheet.Rows.Count, "C").End(xlUp).Row
Debug.Assert lastRowOnMasterSheet >= 9
'range to find names to be checked
Dim datesToLoopThrough As Range
Set datesToLoopThrough = masterSheet.Range("C9:C" & lastRowOnMasterSheet)
Dim toFilterIncludingHeaders As Range
Set toFilterIncludingHeaders = datesToLoopThrough.Offset(-1).Resize(datesToLoopThrough.Rows.Count + 1)
Application.ScreenUpdating = False
'check one data at a time
Dim item As Range
For Each item In datesToLoopThrough
Dim nmStr As String
nmStr = FixStringForSheetName(CStr(item.Text))
' The IF condition below might be problematic if sheet
' already exists, but has not yet had dates
' transferred/copy-pasted to it.
If Not DoesWorksheetExist(nmStr) Then
With CreateSheetFromTemplate(templateSheet)
.Name = nmStr
.Move After:=.Parent.Worksheets(.Parent.Worksheets.Count)
toFilterIncludingHeaders.AutoFilter Field:=1, Criteria1:=item
Intersect(datesToLoopThrough.SpecialCells(xlCellTypeVisible).EntireRow, mastersheet.range("D:Q")).Copy .Range("F13") ' You haven't shown your template sheet, so don't know where to paste to.
End With
End If
Next item
masterSheet.Activate
templateSheet.Visible = originalSheetState
'update screen one time at the end
Application.ScreenUpdating = True
MsgBox "All Reports created"
End Sub
Private Function CreateSheetFromTemplate(ByVal someTemplateSheet As Worksheet) As Worksheet
' Creates a copy of template sheet and returns an object reference to the newly created sheet.
' Newly created sheet is at index 1 (for deterministic/reliability reasons).
' Call site can name/move as needed.
someTemplateSheet.Copy Before:=someTemplateSheet.Parent.Worksheets(1)
Set CreateSheetFromTemplate = someTemplateSheet.Parent.Worksheets(1)
End Function
Private Function DoesWorksheetExist(ByVal sheetNameToCheck As String) As Boolean
' Checks if sheet of a given name exists in ThisWorkbook.
Dim targetSheet As Worksheet
On Error Resume Next
Set targetSheet = ThisWorkbook.Worksheets(sheetNameToCheck)
On Error GoTo 0
DoesWorksheetExist = Not (targetSheet Is Nothing)
End Function
The script below loops through to create tabs and name the tab then it will place the tab name in cell B3. It's been working fine but now gives the catch all runtime error 1004. At the bottom of my script it renames the tab. This is where the error is happening. It's creating the tabs but fails to rename it. Can anyone please suggest another way to rename the tab in this script. The error is on Sheets(Name).Select.
Public Sub CreateTabs()
Sheets("TABlist").Select
' Determine how many Names are on Data sheet
FinalRow = Range("A65000").End(xlUp).Row
' Loop through each Name on the data sheet
For x = 1 To FinalRow
LastSheet = Sheets.Count
Sheets("TABlist").Select
Name = Range("A" & x).Value
' Make a copy of FocusAreas and move to end
Sheets("TABshell").Copy After:=Sheets(LastSheet)
' rename the sheet and put name in Cell B2
Sheets(LastSheet + 1).Name = Name
Sheets(Name).Select
Range("B3").Value = Name
Next x
End Sub
It is very important to write code that is robust. It shouldn't fail in any scenario. For example appropriate error handling should be done and variables declared.
I would recommend reading this.
Topic: To ‘Err’ is Human
Link: http://www.siddharthrout.com/2011/08/01/to-err-is-human/
Now back to your code. I have amended the code. Try this. I have also commented the code so you shouldn't have any difficulty understanding it :) Still if you do, just give a shout.
Code
Option Explicit
Public Sub CreateTabs()
Dim ws As Worksheet
Dim FinalRow As Long, x As Long, LastSheet As Long
Dim name As String
On Error GoTo Whoa
Application.ScreenUpdating = False
Set ws = Sheets("TABlist")
FinalRow = ws.Range("A" & Rows.Count).End(xlUp).Row
For x = 1 To FinalRow
LastSheet = Sheets.Count
'~~> Get the name for the new sheet
name = ws.Range("A" & x).Value
'~~> Check if you already have a sheet with that name or not
If Not SheetExists(name) Then
Sheets("TABshell").Copy After:=Sheets(LastSheet)
ActiveSheet.name = name
Range("B3").Value = name
End If
Next x
LetsContinue:
Application.ScreenUpdating = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
'~~> Function to check if sheet exists
Function SheetExists(wst As String) As Boolean
Dim oSheet As Worksheet
On Error Resume Next
Set oSheet = Sheets(wst)
On Error GoTo 0
If Not oSheet Is Nothing Then SheetExists = True
End Function
Each worksheet name in an Excel workbook needs to be unique.
As a quick fix to see what name is causing the error, try using this code and then check the sheet names against your list.
Public Sub CreateTabs()
On Error Resume Next
Sheets("TABlist").Select
' Determine how many Names are on Data sheet
FinalRow = Range("A65000").End(xlUp).Row
' Loop through each Name on the data sheet
For x = 1 To FinalRow
LastSheet = Sheets.Count
Sheets("TABlist").Select
Name = Range("A" & x).Value
' Make a copy of FocusAreas and move to end
Sheets("TABshell").Copy After:=Sheets(LastSheet)
' rename the sheet and put name in Cell B2
Sheets(LastSheet + 1).Name = Name
Sheets(Name).Select
Range("B3").Value = Name
Next x
On Error GoTo 0
End Sub
I got lost amid all the selects so I am not sure why your original code failed. I edited your question to make it more readable but only I can see the improvement until my edit it peer reviewed.
I have deleted all your select statements. Comments starting '## explain why I have made other changes.
Option Explicit
Public Sub CreateTabs()
Dim CrntRow As Long '## I like names I understand
Dim FinalRow As Long
Dim Name As String
' Determine how many Names are on Data sheet
'## Row.Count will work for any version of Excel
FinalRow = Sheets("TABlist").Cells(Rows.Count, "A").End(xlUp).Row
' Loop through each Name on the data sheet
For CrntRow = 1 To FinalRow
Name = Sheets("TABlist").Range("A" & CrntRow).Value
' Make a copy of FocusAreas and move to end
Sheets("TABshell").Copy After:=Sheets(Worksheets.Count)
' rename the sheet and put name in Cell B2
'## The copy will be the active sheet
With ActiveSheet
.Name = Name
.Range("B3").Value = Name
End With
Next CrntRow
End Sub