Macro to copy- paste a portion of a clomun based on the text the first and last row of a range

[memo14]

Hello gentlemen,

I have a list in column A, let's say from cell A1 to A300. The list contains 16 sections, from section 1 to section 16. Each section has its own header containing the word "section" and the number of section in one cell and the name of the section. After each header there is 10 to 20 rows of text in the same column. The sections are each after each and there is no blank row in between, like this:

Section 1 - ....
....
....
....
....
....
Section 2 - ....
....
....
....
....
....
Section 3 - ....
...


Section 16 -...
...

After Section 16 there are blank rows or a cell with the text "End of sheet". The list ends here and there is nothing after in the column.
I need a macro to go through the column and copy and paste each section in a different column; let's say column B to column Q (for sections 1 to 16)

I have many of those column A of 16 section to organize. I will truly appreciate if you can help me about it.

Thank you very much, in advanced.

Memo

 

[memo14]

I mean ladies / gentlemen!

 

[=ODIN=]

Does this work?

Sub sectify()
    Dim startCol As Integer, offS As Integer, rowCount As Long
    startCol = 1
    offS = 1
    rowCount = 1
    
    For i = 1 To Cells(Rows.Count, startCol).End(xlUp).Row
        If InStr(1, Cells(i, startCol).Value, "section", vbTextCompare) <> 0 Then
            rowCount = 1
            offS = offS + 1
            Cells(rowCount, offS).Value = Cells(i, startCol).Value
            rowCount = rowCount + 1
        
        ElseIf offS <> 1 Then
            Cells(rowCount, offS).Value = Cells(i, startCol).Value
            rowCount = rowCount + 1
        End If
    Next i
    
End Sub

 

[memo14]

Hello Mr./Ms. =ODIN= !

I really appreciate your attention and quick response. It works and does the main job, but there are two small issues.

First, after running the code and copy-pasting the sections, I receive the "Error 1004" and the line 13 becomes highlighted in the code:

Cells(rowCount, offS).Value = Cells(i, startCol).Value

And second, in my sheet sometimes the word "section" exists in the text under the headers; like this:

Section 3 - ....
...
for ...see section 7 ...
...
Section 4 - ...

So, the code breaks, for example, the section 3 in two columns when it reaches to the word "section" in the text.

I was wondering if these problems could be fixed.

Once again, I appreciate your help.

All the best,

Memo
</pre>

 

[=ODIN=]

Does this work?

Sub sectify()
    on error resume next
    Dim startCol As Integer, offS As Integer, rowCount As Long
    startCol = 1
    offS = 1
    rowCount = 1
    
    For i = 1 To Cells(Rows.Count, startCol).End(xlUp).Row
        If InStr(1, left(Cells(i, startCol).Value,7), "section", vbTextCompare) <> 0 Then
            rowCount = 1
            offS = offS + 1
            Cells(rowCount, offS).Value = Cells(i, startCol).Value
            rowCount = rowCount + 1
        
        ElseIf offS <> 1 Then
            Cells(rowCount, offS).Value = Cells(i, startCol).Value
            rowCount = rowCount + 1
        End If
    Next i
    
End Sub

 

[memo14]

Hello again =ODIN=,

I tried the code with this new modification and it is not working.

Thanks a lot for your attempt,

Memo

 

[=ODIN=]

Sorry, at this point I don't know what the problem is. If you share you're workbook I can take a look, otherwise, maybe someone more advanced than I can help.

 

[memo14]

Hello =ODIN=,

Thank you. How Do I can share my workbook?

 

[memo14]

[TABLE="width: 205"]
<tbody>[TR]
[TD]Hello =ODIN=

Let's say the list is like this including 6 sections ( in the reality 16 sections). Thank you in advanced.
Memo

Section 1 - Introduction
[/TD]
[/TR]
[TR]
[TD]o5p5n yryr rtyry76[/TD]
[/TR]
[TR]
[TD]s4 etetet[/TD]
[/TR]
[TR]
[TD]dddd5 rtret[/TD]
[/TR]
[TR]
[TD]Section 2 - Water quality[/TD]
[/TR]
[TR]
[TD]dd6 wetw wtyt5[/TD]
[/TR]
[TR]
[TD]ff7rthry[/TD]
[/TR]
[TR]
[TD]Section 3 - Air qualiy gwfqrq[/TD]
[/TR]
[TR]
[TD]ggrtet reyre[/TD]
[/TR]
[TR]
[TD]gg9 see Section 7 for more detail[/TD]
[/TR]
[TR]
[TD]gerte eter eet[/TD]
[/TR]
[TR]
[TD]grtet ryeyey[/TD]
[/TR]
[TR]
[TD]Section 4 - Soil quality sdgsgdsg[/TD]
[/TR]
[TR]
[TD][py eryyy[/TD]
[/TR]
[TR]
[TD]ryry 0 - See Section 10 for …[/TD]
[/TR]
[TR]
[TD]ytryyreueu[/TD]
[/TR]
[TR]
[TD]Section 5 - gfsgsg sdgsg sdgsdg[/TD]
[/TR]
[TR]
[TD]y eyey eryete qweq[/TD]
[/TR]
[TR]
[TD]rwr t[/TD]
[/TR]
[TR]
[TD]Section 6 - ggegery tjghoi reeyrw y4[/TD]
[/TR]
[TR]
[TD]phjrh eyeyr[/TD]
[/TR]
[TR]
[TD]erye eyeyr[/TD]
[/TR]
[TR]
[TD]nn trhrthrth thrthhh[/TD]
[/TR]
[TR]
[TD]Worksheet End[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[=ODIN=]

Sorry, after putting your data into column A and testing the macro on my pc using excel version 2007, it works just fine for me. I have no idea why it is not workiing for you.