Automatically rename tabs - excel

Question

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

Answer 1

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

Answer 2

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

Answer 3

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