Select range of data based on values in colum A

I have several large sets of data in one spreadsheet and would like to split them into different sheets. For each set of data, the values within column A are identical and amount to approximately 40,000 rows for each data set.

I have found a macro which compares the active cell to the next cell and moves down the rows until the numbers change. At this point it should stop, but it doesn't. The macro is:

Sub testIt()
Dim r As Long, endRow As Long, pasteRowIndex As Long

endRow = 1000001 ' of course it's best to retrieve the last used row number via a function
pasteRowIndex = 1

For r = ActiveCell To endRow 'Loop through sheet1 and search for your criteria

If Cells(ActiveCell).Value = Cells(ActiveCell.Offset(1, 0)).Value Then 'Found

        'Select next
        ActiveCell.Offset(1, 0).Select
        
        

End If
Next r
End Sub

Even if this worked, I am sure it would take an age to go through all 40,000 rows for the data set. And a lifetime for all 2,000 data sets that it needs to go through.

Can anyone recommend a quick way of exporting each data set into a different sheet? If not please fix the macro above.

Many thanks