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

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