Split worksheet into multiple worksheets with headers

Hi,

I have a worksheet that is derived from a csv file export, the sheet has several sections that are start with a header row beginning with a specific value in the first cell of the row. For example a section could look like this:

:AlarmGrp	Group	Comment	EventLogged
Kansas	Kansas City	Alarm Group for Kansas City	Yes

The number of rows between that section and the next can vary, however the next section will start similarly:

:MemoryDisc	Group	Comment	Logged
Alarm_In_1	Kansas City	Alarm In 1 for Kansas City	Yes

What I would like to be able to do is split the sections into each of their own worksheets, worksheets labelled with the section name, but carrying over also the row containing the header detail.

Is this possible?

I have played about with the macro recorder, and I can split the worksheet for one section but not having much luck cobbling together a better solution.

Can you attach a sample showing your data file and what you expect as your output.

Go Advanced -> Manage Attachments -> Upload

Thanks, sample file uploaded.

Here is a Power Query solution;

According to your attachment a demo creating destination worksheets if necessary :

PHP Code: 

Sub Demo1()
           Dim Rg As Range, F&, L&, S$
    With Sheets("MainImport").UsedRange.Rows
           Set Rg = .Columns(1).Find(":*", .Cells(1), xlValues, xlWhole)
        If Not Rg Is Nothing Then
                F = 1
                Application.ScreenUpdating = False
            Do
                L = IIf(Rg.Row > F, Rg.Row - 1, .Count)
                S = Mid$(.Cells(F, 1).Value, 2)
                If Evaluate("ISREF('" & S & "'!A1)") Then Sheets(S).UsedRange.Clear _
                                                     Else Sheets.Add(, Sheets(Sheets.Count)).Name = S
               .Item(F & ":" & L).Copy Sheets(S).[A1]
                Sheets(S).UsedRange.Columns.AutoFit
                If L = .Count Then Exit Do
                F = Rg.Row
                Set Rg = .Columns(1).FindNext(Rg)
            Loop
                Set Rg = Nothing
                Application.ScreenUpdating = True
        End If
    End With
End Sub 


Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !