Find String in Column A, Cut & Paste to Other Columns

[dgr]

Hi,
I'm using Excel 2007. I'm looking for a VBA macro solution.

In Column A, I've got text like this:
<b>Column A</b>
This is my Year
apple
boy

cat
snake


This is Year 2003
banana
girl
leaf
elephant


2004 is a good Year
dog
wolf
apple

mango

I want to find <b>Year</b> including all records below it, cut & paste it in the Column next to it. Therefore, eventually all Column headers will contain the word <b>Year</b> in it. The end result should look something like this:
<b>Column B</b>----------<b>Column C</b>----------------<b>Column D</b>
This is my Year----This is Year 2003--------2004 is a good Year
apple----------------banana-------------------dog
boy------------------girl-----------------------wolf
----------------------leaf-----------------------apple
cat-------------------elephant------------------
snake-------------------------------------------mango

the word <b>Year</b> is case sensitive. Could you show me the code please?

Thanks.

 

[XOR LX]

Hi.

Assuming your list begins in A1:

Sub Years()

Dim YearRows() As String
Dim Rng As Range
Dim LRow As Long, n As Long

LRow = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Range("A1:A" & 1 + LRow)

n = 1

For Each r In Rng
    If InStr(1, r, "Year") > 0 Or r.Row = LRow + 1 Then
        ReDim Preserve YearRows(n)
        YearRows(n) = r.Row
        n = n + 1
    End If
Next r

For i = 1 To UBound(YearRows) - 1
    Range("A" & YearRows(i) & ":A" & YearRows(i + 1) - 1).Copy Destination:=Cells(1, i + 1)
Next i

End Sub

 

[dgr]

Excellent help, XOR LX. Thank you very much. I appreciate this.

 

[XOR LX]

You're welcome! Thanks for the feedback.

Cheers