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]

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

o5p5n yryr rtyry76

s4 etetet

dddd5 rtret

Section 2 - Water quality

dd6 wetw wtyt5

ff7rthry

Section 3 - Air qualiy gwfqrq

ggrtet reyre

gg9 see Section 7 for more detail

gerte eter eet

grtet ryeyey

Section 4 - Soil quality sdgsgdsg

[py eryyy

ryry 0 - See Section 10 for …

ytryyreueu

Section 5 - gfsgsg sdgsg sdgsdg

y eyey eryete qweq

rwr t

Section 6 - ggegery tjghoi reeyrw y4

phjrh eyeyr

erye eyeyr

nn trhrthrth thrthhh

Worksheet End

<tbody>
</tbody>

 

[=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.