How to Separate the worksheet based on data

Sub CreateSheetsCopyData()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

        Dim ar As Variant
        Dim i As Integer
        Dim LR As Long
        Dim c As Range
        Dim ws As Worksheet
        
ar = Array("175702", "175479", "175483")
LR = Range("A" & Rows.Count).End(xlUp).Row

For Each c In Range("A2:A" & LR)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        If ws Is Nothing Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
        End If
  Next c
      
Sheet1.Select
    For i = 0 To UBound(ar)
         Range("A1", Range("A" & Rows.Count).End(xlUp)).AutoFilter 1, ar(i)
         Range("B1", Range("E" & Rows.Count).End(xlUp)).Copy Sheets(ar(i)).Range("A" & Rows.Count).End(xlUp)
         Sheets(ar(i)).Columns.AutoFit
    Next i
   [A1].AutoFilter
   
For Each ws In ActiveWorkbook.Sheets
    If ws.Range("A1") = "" Then ws.Delete
Next ws
   
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "Data transfer completed!", vbExclamation, "Status"

End Sub