One duplicate when splitting workbook to different worksheets based on value?

[Human_doing]

Hi all,

The below VBA codes ask a user to select a file and then splits the selected worksheet in to many different worksheets based on the value in column A, however when I run it it always seems to split one (and only one) of the options in to two worksheets, i.e. if there are 100 rows of data in the selected sheet and 10 different variables, it will create 11 worksheets, 10 with the 10 different variables and 11 called 'sheet 12' that is a duplicate of one of the variables?

Can anyone please check if there is anything in the below code that creates a duplicate for any reason?

Many thanks in advance for any help

Sub Splitter

'Ask user to select Excel file
NewFN = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Select the file with raw data for the report")
If NewFN = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
Exit Sub
Else
Workbooks.Open Filename:=NewFN
End If
 
'Copy cells from sheet 1, paste to new workbook
Cells.Select
Selection.Copy
Workbooks.Add
Range("a1").PasteSpecial xlPasteAll
Application.CutCopyMode = False

    
'Split cells to separate worksheets based on values
Dim lastrow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim WS As Worksheet
Application.ScreenUpdating = False
With ActiveSheet
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), .Cells(lastrow, LastCol)).Sort Key1:=.Range("A2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iStart = 2
For i = 2 To lastrow
If .Range("A" & i).Value <> .Range("A" & i + 1).Value Then
iEnd = i
Sheets.Add after:=Sheets(Sheets.Count)
Set WS = ActiveSheet
On Error Resume Next
WS.Name = .Range("A" & iStart).Value
On Error GoTo 0
WS.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
With WS.Rows(1)
.HorizontalAlignment = xlCenter
With .Font
.ColorIndex = 5
.Bold = True
End With
End With
.Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=WS.Range("A2")
iStart = iEnd + 1
End If
 
End Sub