split rows into multiple worksheets by header

karissao

New Member
Joined
Feb 5, 2010
Messages
8
I have a large excel worksheet with many groups in it. Each group begins with an identical header row. Currently, I just split up each group with page breaks.

I need to make a macro which splits each group into a separate worksheet tab each time it finds the header. Here is the header:

HSE STREET APT ZIP2 STATUS NAME PHONE MTHLY CUR BILL B1 B2 DIG HSD CDV Contact Refusal In-house Present COMMENTS

Please help!
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

jbeaucaire

Well-known Member
Joined
May 8, 2002
Messages
6,012
Are there blank rows between the sections? If so, you could employ the .AREAS function in a macro to copy each area to a sheet of its own.
 

karissao

New Member
Joined
Feb 5, 2010
Messages
8
no- that won't work. The actual type of info in each packet varies- see below. But the header is always the same.

Header
data row
data row
data row
data row
header
image (several rows)
data row
blank row
header
data row
 

karissao

New Member
Joined
Feb 5, 2010
Messages
8
It would actually be just as good if it split into worksheets between manual page breaks, as there is a page break after every group.
 

jbeaucaire

Well-known Member
Joined
May 8, 2002
Messages
6,012

ADVERTISEMENT

Give this a try. It assumes the "COMMENTS" string is unique to each section.

The macro also assumes the first match is in row 1...
Code:
Option Explicit

Sub SplitGroups()
'JBeaucaire   2/5/2010
'Splits groups of data to separate sheets
Dim rFind As Range, rTop As Range, rFirst As Range
Dim dSht As Worksheet, Cnt As Long
Application.ScreenUpdating = False

Set dSht = Sheets("Sheet1")     'data sheet
Set rFirst = dSht.Range("A1")
Set rTop = dSht.Range("A1")
Set rFind = dSht.Cells.Find("COMMENTS", After:=dSht.[A2], LookIn:=xlValues, LookAt:=xlPart)

Do
    Cnt = Cnt + 1
    If rFind.Address <> rFirst.Address Then
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Group" & Cnt
        dSht.Range(rTop, rFind.Offset(-1, 0)).EntireRow.Copy Range("A1")
        Set rTop = rFind
        Set rFind = dSht.Cells.Find("HSE", After:=rFind, LookIn:=xlValues, LookAt:=xlPart)
    Else
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Group" & Cnt
        dSht.Range(rTop, dSht.Range("A" & Rows.Count).End(xlUp)).EntireRow.Copy Range("A1")
        Exit Do
    End If
Loop

Application.ScreenUpdating = True
End Sub
 

karissao

New Member
Joined
Feb 5, 2010
Messages
8
wow- not sure what happened, but by the time I aborted it, there were over 1600 sheets! It would awesome if you would email me at karissame.martin@gmail.com so I can send you the file I am trying to break up. Is that allowed?
 

jbeaucaire

Well-known Member
Joined
May 8, 2002
Messages
6,012
You can trade email addresses using the forum's Private messaging system, so you don't have to post your email address in an open thread. Just click on the names to the left...

Meanwhile, I sent you an email...


The macro is using the word "COMMENTS" to spot each header and copying all the data in between rows with the word "COMMENTS" on them. That should work if "COMMENTS" is a unique text string to your headers.
 

Forum statistics

Threads
1,143,661
Messages
5,720,145
Members
422,267
Latest member
olund

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top