Help to code not work on Sheet with many rows and columns.

Hi I have below code. It was working on a test sheet but when i now try it on a very big file it give me an error.
The code sort the rows in a chosen column. And add sheets with that name. So if in column Austria is there, it will create a sheet called Austria and put all rows with Austria in there. The File i am working with have 100 columns and 115806 rows. It give me this error message in the red field.

ActiveSheet.Name = x

The name is all ready taken try a new one.


Please have a look i cant off course attach a so big file. But would be happy if some know and can help with that.

Thanks in advance

Sincerely

Abjac

Sub abjacz2()
Dim rcell As Range, x As String, y As String
Dim z As String
y = InputBox("Please Enter The Column:  (Letter Designation)")
z = InputBox("Enter the name of the start page, example sheet1")
With Sheets(z)
.Columns(y).Replace " ", "", xlPart
    For Each rcell In .Range(y & "3:" & y & .Range(y & Rows.Count).End(3).Row)
        If rcell.Value <> rcell.Offset(-1).Value Then
            x = rcell.Value
            Sheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = x
            Sheets(x).Rows(1).Value = Sheets(z).Rows(1).Value
        .Range(y & "1:" & y & .Range(y & Rows.Count).End(3).Row).AutoFilter 1, x
        .Range(y & "2:" & y & .Range(y & Rows.Count).End(3).Row).SpecialCells(12).EntireRow.Copy Sheets(x).Range("A" & Rows.Count).End(3)(2)
        .AutoFilterMode = False
        End If
    Next rcell
End With
End Sub

try changing,

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = x

to

If Not Evaluate("ISREF('" & x & "'!A1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = x

adds a new sheet with the x string value, if that sheet name doesn't exist already