split worksheet into separate worksheets based on row content

[tbruce]

Hi,

Hoping someone could help me with this. I've been trying to find a way to do this and just can't get there. What I have is a combined spreadsheet that prior was multiple workbooks/sheets (don't have the original) and was combined into one very large worksheet. Each segment of the worksheet has a header row that starts with SOURCE in the first column (with the same header labels across the row) then about 500 + or - rows of data below it then another header row with SOURCE, etc... I need to break these out to separate workbooks based on the header rows (SOURCE) separation. This appears about 10 times throughout the one worksheet. Hoping someone could point me in the right direction with VBA code or a formula or even a Kutools or ASAP feature.

Here is a small snippet of an example sheet with the combined data and header rows in rows 1 and 6 then so on:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Source[/TD]
[TD]Date[/TD]
[TD]Time[/TD]
[TD]Activity[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]car[/TD]
[TD]2-12-2019[/TD]
[TD]2240[/TD]
[TD]routing[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]car[/TD]
[TD]5-22-2019[/TD]
[TD]1304[/TD]
[TD]routing[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]bicycle[/TD]
[TD]6-02-2019[/TD]
[TD]1134[/TD]
[TD]one way[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]bicycle[/TD]
[TD]7-24-2019[/TD]
[TD]0700[/TD]
[TD]routing[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Source[/TD]
[TD]Date[/TD]
[TD]Time[/TD]
[TD]Activity[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]car[/TD]
[TD]2-03-2019[/TD]
[TD]0530[/TD]
[TD]routing[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]car[/TD]
[TD]4-02-2019[/TD]
[TD]0830[/TD]
[TD]routing[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]bicycle[/TD]
[TD]4-25-2019[/TD]
[TD]1030[/TD]
[TD]oe way[/TD]
[/TR]
</tbody>[/TABLE]


Would very much appreciate any guidance on this one.

 

[Fluff]

How do you want the sheets named?

 

[tbruce]

How do you want the sheets named?

Consecutive numbers like sheet1 sheet2 sheet3

 

[Fluff]

Ok, how about

Sub tbruce()
   Dim Ar As Areas
   Dim Rng As Range
   
   With Range("A:A")
      .Replace "Source", "=xxxSource", xlWhole, , False, , False, False
      Set Ar = .SpecialCells(xlConstants).Areas
      .Replace "=xxxSource", "Source", xlWhole, , False, , False, False
   End With
   For Each Rng In Ar
      Sheets.Add , Sheets(1)
      Rng.Offset(-1).Resize(Rng.Count + 1).EntireRow.Copy Range("A1")
   Next Rng
End Sub

 

[tbruce]

Hi Fluff - I'm revisiting this and trying another run at a similar dataset, but this time instead of a single word in the header field in column A, I have a variable that changes, but the first two words are always "Search Criteria" then a variety of numbers e.g. " - #####". I can't seem to look for a portion of the cell value. Any suggestions?