将数据移到目标表并格式化输出

Question

我在Sheet2的A：L列中存储了数据，并希望基于起点（作为某些单元格文本和终点），再次作为某些单元格文本复制每个块！数据在A：L列中，并逐块向下移动

我拥有的代码几乎完成了100％，但是我要实现的最后一部分是将每个项目按特定顺序放在目标表上。我们知道列是A：L，我想将我的第一个块粘贴到目标的列A：L中，然后将其粘贴到M：X中的下一个块中，然后将其粘贴到Y：AJ中的最后一个块中。 因为我设想其中大约有10个块，例如Tank Engine，Weatherman等，所以我将首先需要三个块，然后需要大约三行，这些行之间有空隙，然后重复。

此示例

行是动态的，但长度不能超过11。我的代码是

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

感谢PEH的初步帮助，也感谢您的关注！

Answer 1

通过编辑源数据中的字符串，然后编写x个宏以覆盖我的场景，然后在模块中一个一个地调用它们，我设法做到了