Excel - VBA to split data into sheets without keeping entire range

Question

I have utilized some code created by Ron de Bruin (linked at the bottom of this question) for quite some time in order to split a large table into multiple sheets based on whenever the values change in column A.

I have a new project with similar needs however this code is unfortunately not sufficient as is for two main reasons:

1 - The final data that I need should have no header row, yet this code treats Row 1 as a header and adds it on each created sheet.

2 - The data that I am using starts with no unique identifier but instead, a numeric identifier for what should be each new sheet. I can create a unique identifier in column A, but then this unnecessary column of data will be copied, along with the necessary data, into each created sheet.

Here is what the raw table and data looks like.

Here is how we need the data in each individual sheet

I would greatly appreciate any assistance in finding a solution for my problem here as I am very much a novice with VBA.

Thank you

https://www.rondebruin.nl/win/s3/win006_4.htm

EDIT: Just for posterity, I am linking the clunky code that I came up with. It works which is I guess what counts. I was only able to get it to work by deleting data as it goes so that the range always begins at "A1".

Dim BOTTOM_VAL As Long


BOTTOM_VAL = Range("A2").Value


Do Until Range("A1") = 0
    
  If (Range("A" & (BOTTOM_VAL + 1)).Value = 1) Or (Range("A" & (BOTTOM_VAL + 1)).Value = 0) Then

   Sheets("Sheet1").Range("A1", "O" & BOTTOM_VAL).Select
   Selection.Cut
   Worksheets.Add After:=Sheets(Sheets.Count)
   Range("A1").Select
   ActiveSheet.Paste
   ActiveSheet.Name = Range("B1") & "-" & Range("C1")
   Worksheets("Sheet1").Activate
   Sheets("Sheet1").Range("A1", "O" & BOTTOM_VAL).EntireRow.Delete
   BOTTOM_VAL = Range("A2").Value
  
  Else
  
    ' In case the loop breaks
      If Range("A1").Value = 0 Then
        Exit Sub
        
      Else
        BOTTOM_VAL = (BOTTOM_VAL + 1)
      End If
    
  End If

Loop
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Application.DisplayAlerts = True

End Sub