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

CodePudding user response：

If I'm not mistaken to get what you mean, maybe something like this ?
The code assumed that the id of the data is changed if the cell value in column A is 1.

Sub test()
Set rg = Range("A1", Range("A" & Rows.Count).End(xlUp))
For Each cell In rg
Range(cell, cell.Offset(0, 13)).Copy
    If cell.Value = 1 Then
        Set WSnew = Worksheets.Add(After:=Sheets(Sheets.Count))
            If WSnew.Range("A1").Value = "" Then _
                WSnew.Range("A1").PasteSpecial (xlValues)
    Else
        Set oStart = WSnew.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        oStart.PasteSpecial (xlValues)
    End If
Next
End Sub

The process:

1. The code take all the value in column A of an active sheet where the macro is run by the range ---> rg.
2. then it loop to each cell in rg, copy the row of the cell from A to N
3. check if the cell value is 1 then it will create a new worksheet and paste to cell A1 of the newly created sheet.
4. if the cell value is not 1 then it will paste to the next available blank row of the newly created sheet.

I'm not sure though if this is what you mean.