Macro needed for extracting to Tab

[KiloHotel]

Hi all,

I am wondering if there is a way of extracting a range of cells into seperate tabs from the one long sheet.

Let me give you my issue,

I have one sheet with alot of tables and data, Someone glued it all together and i need each table into separate tabs,

At present it is currently like this:

SOB	BBEE
TEST 1	TEST1
TEST 2	TEST3
TEST 3	TEST3
SOB	BBEE
TEST11	TEST11
TEST12	TEST13

<tbody>
</tbody>

So Anywhere Cell A & B say SOB & BBEE it is a new table all the way down until it says it again. The tables vary in length and they are not all the same. but there is 250+ tables all glued like this (idiotic) but i am screaming for help at this stage if anyone can please


Thanks!

 

[Fluff]

SOB is in its own "Merged Cell"

Arrrggg
Merged cells are a complete nightmare & to be avoided at all costs.
If you pick one of the SOB cells what cells are merged?

 

[KiloHotel]

Arrrggg
Merged cells are a complete nightmare & to be avoided at all costs.
If you pick one of the SOB cells what cells are merged?

Yeah, I know, This whole file is a bloody nightmare, Cells D,E,F,G,H row 6 is the SOB merged cells then the next SOB merged cells could be row 28 then 66 etc.

 

[Fluff]

The problem may be in that you originally said

So Anywhere Cell A & B say SOB & BBEE

so the code was looking in col A.
Try

Sub Splitdata()

   Dim Ws As Worksheet
   Dim Ar As Areas
   Dim Rng As Range
   
   Set Ws = ActiveSheet
   With Ws.Range("D1", Ws.Range("D" & Rows.Count).End(xlUp))
      .Replace "SOB", "=XXSOB", xlWhole, , False, , False, False
      Set Ar = .SpecialCells(xlConstants).Areas
      .Replace "=XX", "", xlPart, , False, , False, False
      For Each Rng In Ar
         Worksheets.Add , Sheets(Sheets.Count)
         Rng.Offset(-1).Resize(Rng.Count + 1).EntireRow.Copy ActiveSheet.Range("A1")
      Next Rng
   End With
End Sub

 

[KiloHotel]

The problem may be in that you originally said so the code was looking in col A.
Try

Sub Splitdata()

   Dim Ws As Worksheet
   Dim Ar As Areas
   Dim Rng As Range
   
   Set Ws = ActiveSheet
   With Ws.Range("D1", Ws.Range("D" & Rows.Count).End(xlUp))
      .Replace "SOB", "=XXSOB", xlWhole, , False, , False, False
      Set Ar = .SpecialCells(xlConstants).Areas
      .Replace "=XX", "", xlPart, , False, , False, False
      For Each Rng In Ar
         Worksheets.Add , Sheets(Sheets.Count)
         Rng.Offset(-1).Resize(Rng.Count + 1).EntireRow.Copy ActiveSheet.Range("A1")
      Next Rng
   End With
End Sub

Whoops, Yeah sorry about that!

I ran that one and it created loads of tabs but 500+ and only just chopped info in each one.. :S

Its nearly there, the idea is right but it isn't working just yet!

 

[Fluff]

Do you only have SOB in the "header row" of each section?

 

[KiloHotel]

Do you only have SOB in the "header row" of each section?

In the Header row it is like this

SOB

BBEE

<tbody>
</tbody>

"SOB" is merged as D to H and "BBEE" is merged I to M, That is the first line of each of these then follows that data in the rows after until it hits that header again indicating the next bit.

 

[Fluff]

Will SOB appear anywhere other than the header?

 

[KiloHotel]

Will SOB appear anywhere other than the header?

No it is unique to the header alongside BBEE

 

[Fluff]

Ok, do you have formulae in col D? If so will you ever have either TRUE or FALSE in that col?

 

[KiloHotel]

Ok, do you have formulae in col D? If so will you ever have either TRUE or FALSE in that col?

No, It is just plain data in this workbook, No formula's are in it.