tab creation failure using macro

Question

I have to manipulate a gigantic excel file, but I had some problems using VBA.

This this excel file has 28 tabs and all have 53 columns. The tabs are about years, some years have more persons in. All the first column its about Person_system_ID and the second its his name, all of them are in uppercase.

I tried to use ChatGPT to write a VBA code to map all the tabs and create a separate tab for each unique name and save, but I got some errors.

Here is the code that ChatGPT wrote:

Function IsInArray(arr, val) As Boolean
    Dim found As Boolean
    found = False
    
    If IsArray(arr) And Not IsEmpty(arr) Then
        Dim i As Long
        For i = LBound(arr) To UBound(arr)
            If arr(i) = val Then
                found = True
                Exit For
            End If
        Next i
    End If
    
    IsInArray = found
End Function

Sub Create_Individual_Sheets()
    Dim SheetName As String
    Dim NameList() As String
    Dim LastRow As Long
    Dim Year As Integer
    Dim Sheet As Worksheet
    Dim NewSheet As Worksheet
    Dim Name As Variant
    Dim i As Long
    Dim Folder As String
    
    Folder = "C:\Users\Jorjao\Desktop\Folder"
    
    For Year = 1994 To 2022
        Set Sheet = Worksheets(CStr(Year))
        LastRow = Sheet.Cells(Rows.Count, 1).End(xlUp).Row
        
        'loop through the name column in the current sheet and add to the name list
        For i = 2 To LastRow
            Name = UCase(Sheet.Cells(i, 2).Value)
            If Not IsInArray(NameList, Name) Then
                ReDim Preserve NameList(UBound(NameList) + 1)
                NameList(UBound(NameList)) = Name
            End If
        Next i
    Next Year
    
    'loop through the name list and create an individual sheet for each name
    For Each Name In NameList
        Set NewSheet = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
        SheetName = Replace(Name, " ", "_")
        NewSheet.Name = SheetName
        
        'loop through each sheet and copy the rows with the current name to the individual sheet
        For Year = 1994 To 2022
            Set Sheet = Worksheets(CStr(Year))
            LastRow = Sheet.Cells(Rows.Count, 1).End(xlUp).Row
            
            'loop through the name column in the current sheet and check if the current name is present
            For i = 2 To LastRow
                If UCase(Sheet.Cells(i, 2).Value) = Name Then
                    Sheet.Rows(i).Copy Destination:=NewSheet.Rows(NewSheet.Cells(Rows.Count, 1).End(xlUp).Row.Offset(1))
                End If
            Next i
        Next Year
        
        'save the new sheet in a folder
        NewSheet.Copy
        ActiveWorkbook.SaveAs Filename:=Folder & SheetName & ".xlsx"
        ActiveWorkbook.Close savechanges:=False
    Next Name
End Sub

Using this code, I got:

Runtime error 9

Subscript out of range

I also tried to change somethings, but I also got some runtime error like 13 and 424.