Copy Sheet to new Workbook depending on Sheet name or value in A1

Hello everyone,
my name is Ana and I hope you can help me.
I have one big report with +300 sheets. Each sheet has a 6-digit name and some of the sheets have the same first 3 digit in name (e.g. one is named 600000 and some other 600111). I need to copy all the sheets with the same first 3 digits in new workbook one after another. If one sheet has an unique 3 digit name it should be in a separate workbook.
I tried solving this with naming cell A1 in each sheet after 3-digit and then comparing wheather value in cell A1 in two sheets in row is different or the same, but did not succeed. This is what I did:

Sub Macro2()
 ' Macro2 Macro
 For i = 1 To Sheets.Count
 Sheets(i).Copy
 Windows("ana.xlsm").Activate
 If Worksheets(i).Range("A1").Value = Worksheets(i + 1).Range("A1").Value Then Sheets("i+1").Copy After:=Workbooks("Book1").Sheets(i)
 Windows("ana.xlsm").Activate
 End
 Next
 End Sub

Thank you and
Kind regards,
Ana

Welcome to the forum Ana.

You should put your code within code tags, as per forum rules.