Excel VBA Code to Create New Sheets Upon New Entry In Field

[IGPOD]

Okay, so I need a macro that will add new sheets to a workbook when new names are added to the specified field.

The code below is one which I found online and it works for the purposes of creating sheets per entry in the field (column A), however, whenever I add more names to the list in column A, and try to run the code again, I get an error message (see below)

Public Sub Extraction_to_new_sheets()
      
    Dim My_Range As Range
    Dim My_Cell As Variant
    Dim sh_Original As Worksheet
     
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
          
    Set sh_Original = ActiveSheet
     
    On Error Resume Next
    Sheets("TEMPXXX").Delete
    On Error GoTo 0
    Worksheets.Add
    ActiveSheet.Name = "TEMPXXX"
          
    Worksheets("Sheet1").Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
    CopyToRange:=Columns("A:A"), Unique:=True
     
    Set My_Range = Range("A2:A" & Range("A65536").End(xlUp).Row)
          
    For Each My_Cell In My_Range
        
        On Error Resume Next
        Sheets(My_Cell.Value).Delete 'delete if already exists
        On Error GoTo 0
        Worksheets.Add
        ActiveSheet.Name = My_Cell.Value
                 
        sh_Original.UsedRange.AutoFilter Field:=1, Criteria1:=My_Cell.Value
        sh_Original.Cells.SpecialCells(xlVisible).Copy Destination:=Range("A1")
        Columns.AutoFit
    Next
    
    Worksheets("TEMPXXX").Delete
    sh_Original.AutoFilterMode = False
    Set sh_Original = Nothing
     
    Application.DisplayAlerts = True
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
     
End Sub