Help with a Macro

[KiloHotel]

Hi Guys,

I have a worksheet with alot of data that was given to me with all the information "Glued" together instead of separated into tabs.

I have basically the macro figured out that everytime it goes down the sheet and its met with the Keyword SOB that it cuts and copies to the next sheet, That's fine but my issue is that it doesnt "Cut" at the bottom, So as a result the next sheet has the correct data at the top but drags across whatever is below it from the original sheet into it and its not ideal.

Another way of explaining this would be :

I have the original data as this:

[TABLE="width: 200"]
<tbody>[TR]
[TD]SOB[/TD]
[TD]DATA 1[/TD]
[/TR]
[TR]
[TD]TEST1[/TD]
[TD]TEST1[/TD]
[/TR]
[TR]
[TD]TEST2[/TD]
[TD]TEST3[/TD]
[/TR]
[TR]
[TD]SOB[/TD]
[TD]DATA 2[/TD]
[/TR]
[TR]
[TD]TEST3[/TD]
[TD]TEST3[/TD]
[/TR]
[TR]
[TD]TEST4[/TD]
[TD]TEST4[/TD]
[/TR]
</tbody>[/TABLE]

All glued together and the macro will drag SOB DATA1 to the next sheet and then all data below it and then subsequently the next sheet after drags Data 2 then everything else after... So i just need it to Cut from the top and then the next time it hits SOB.

This is the Macro I am using:


Sub Splitdata()


Dim Ws As Worksheet
Dim Ar As Areas
Dim i As Long

Set Ws = ActiveSheet
Ws.Range("D" & Rows.Count).End(xlUp).Offset(1).Value = "SOB"
With Ws.Range("D1", Ws.Range("D" & Rows.Count).End(xlUp))
.Replace "SOB", "=XXSOB", xlWhole, , False, , False, False
Set Ar = .SpecialCells(xlFormulas, xlErrors).Areas
.Replace "=XX", "", xlPart, , False, , False, False
For i = 1 To Ar.Count - 1
Worksheets.Add , Sheets(Sheets.Count)
Ar(i).Resize(Ar(i + 1).Row - 1).EntireRow.Copy ActiveSheet.Range("A1")
Next i
End With
End Sub

 

[KiloHotel]

Anyone?

 

[Peter_SSs]

I have removed the quote of your first post from the second as it does not add any further information and just makes the post harder to navigate/read.

<del>To your question: I can't really see what is going wrong with your current code. What columns is that sample data from post#1 in? If there is also data in other columns, can you dummy up a another small set of sample data and show us what the results are and what they should be so we can understand.</del>

Edit: Never mind, I can now see the problem. I'll be back shortly.

 

[Peter_SSs]

Try replaceing the first line below with the second.

<del>Ar(i).Resize(Ar(i + 1).Row - 1).EntireRow.Copy ActiveSheet.Range("A1")</del>
Ar(i).Resize(Ar(i + 1).Row - Ar(i).Row).EntireRow.Copy ActiveSheet.Range("A1")

 

[KiloHotel]

Perfect! I knew it was something very silly! Just i needed a fresh pair of eyes! Thanking you sir!

 

[Peter_SSs]

Perfect! I knew it was something very silly! Just i needed a fresh pair of eyes! Thanking you sir!

You are very welcome.