Argthtjtr

I have my data in columns A:L in Sheet2 and wish to copy each block based on the starting point, as certain cell text and the end point, again as certain cell text! The data is in columns A:L and move down down block by block

The code I have is very nearly 100% complete, but the last part I am trying to achieve is to put each item in a specific order on the destination sheet. As we know columns are A:L I want to paste my first block into Columns A:L in the destination then the next one in M:X then the final one in Y:AJ.
As there are about 10 of these blocks, Tank Engine, Weatherman etc I envisage, that I will need three blocks first, then a about three rows which are gaps before it is then repeated.

An example of this

The rows are dynamic but never more than 11 in length. The code I have is

Option Explicit



Sub MIKE3()

    Dim wsSrc As Worksheet 'define source

    Set wsSrc = ThisWorkbook.Worksheets("Sheet1")



    Dim wsDest As Worksheet 'define destination

    Set wsDest = ThisWorkbook.Worksheets("Sheet2")



    Dim FindList As Variant 'defind search words

    FindList = Array("Tank Engine")



    Dim i As Long



    Dim FindItm As Variant

    For Each FindItm In FindList

        Dim CopyRange As Range

        Set CopyRange = FindMyRange(wsSrc.Range("A:L"), FindItm, "INFORMATION: " & FindItm)

        If Not CopyRange Is Nothing Then

            CopyRange.Copy wsDest.Range("A1").Offset(ColumnOffset:=i) 'note that if the first column uses merged cells the ColumnOffset:=i otherwise it is ColumnOffset:=i*12

            i = i + 1

        End If

    Next FindItm

End Sub

Function FindMyRange(SearchInRange As Range, ByVal StartString As String, ByVal EndString As String) As Range

   'find start

    Dim FoundStart As Range

    Set FoundStart = SearchInRange.Find(What:=StartString, LookAt:=xlWhole)



    If FoundStart Is Nothing Then GoTo ERR_NOTHING_FOUND

    find end

    Dim FoundEnd As Range

    Set FoundEnd = SearchInRange.Find(What:=EndString, LookAt:=xlWhole, After:=FoundStart)



    If FoundEnd Is Nothing Then GoTo ERR_NOTHING_FOUND



    Set FindMyRange = SearchInRange.Parent.Range(FoundStart, FoundEnd).Resize(ColumnSize:=12)



    Exit Function'



ERR_NOTHING_FOUND:

    FindMyRange = Nothing

End Function

thanks to PEH for his initial help and Thank you for looking!

I managed to make this work by editing the strings in my source data then writing x number of macros to cover my scenarios then calling them one by one in a module