Копирование данных из выбора строк на другой лист на основе начала и конца строки ячейки

Question

У меня есть данные в столбцах A: L на Листе 2, и я хочу скопировать каждый блок на основе начальной точки, как определенного текста ячейки и конечной точки, снова как определенного текста ячейки!

Таким образом, в данном примере начальный текст ячейки должен быть «Tank Engine», а конечный текст ячейки - «INFORMATION: Tank Engine». Поэтому столбец A: L, строки 1:18 следует скопировать в Sheet3 в ячейке A1, но только там, где существует текст ячейки, поскольку это может быть динамическим. Мне нужно сослаться на столбец A для вставки в Sheet3 и скопировать только строки, которые начинаются с «Tank Engine» и заканчиваются «INFORMATION: Tank Engine», которые являются строками 1:18. Следующим блоком будут столбцы A: L, строки 25:41, основанные на строке «Weatherman», которая вставляется в ячейку Sheet3 M: X и т. Д. .....

Строки динамические, столбцы статические ..... Я пробовал много разных фрагментов VBA, но это довольно специфично, поэтому не могу найти хорошее соответствие !!

Sub Mike4()
Dim i As Long
lastcolumn = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To lastcolumn
    If Cells(1, i) = "Tank Engine" Then
        'lastrow = Columns(i).SpecialCells(xlLastCell).Row
        lastRow = Columns(i).Find("INFORMATION: Tank Engine").Row
        Range(Cells(2, i), Cells(lastRow, i)).Copy Sheet3.Range("A" & Sheet3.Range("A" & Rows.Count).End(xlUp).Row + 1)
    End If
Next i
End Sub

Я пытаюсь получить вышеизложенное, чтобы затем вставить столбцы с затронутыми строками в определенную ячейку, а затем выполнить поиск Weatherman, как описано выше, но мне нужна отправная точка, чтобы что-то работало, и затем можно было бы опираться на это ... Как указывалось ранее, у меня есть много фрагментов кода, но ни один из них не работает для того, чего я хочу достичь, если вообще буду. Любая помощь будет принята с благодарностью! Заранее спасибо ... Большое спасибо !!

Answer 1

Посмотрите на этот пример:

Option Explicit

Sub CopyMyStuff()
    Dim wsSrc As Worksheet
    Set wsSrc = ThisWorkbook.Worksheets("SourceSheet")

    Dim wsDest As Worksheet
    Set wsDest = ThisWorkbook.Worksheets("Sheet3")

    'find start
    Dim FoundStart As Range
    Set FoundStart = wsSrc.Range("A:L").Find(What:="Tank Engine", LookAt:=xlWhole)

    If FoundStart Is Nothing Then
        MsgBox "start not found"
        Exit Sub
    End If

    'find end
    Dim FoundEnd As Range
    Set FoundEnd = wsSrc.Range("A:L").Find(What:="INFORMATION: Tank Engine", LookAt:=xlWhole, After:=FoundStart)

    If FoundEnd Is Nothing Then
        MsgBox "start not found"
        Exit Sub
    End If

    wsSrc.Range(FoundStart, FoundEnd).Resize(ColumnSize:=12).Copy wsDest.Range("A1")
End Sub

Или более элегантно с функцией:

Option Explicit

Sub CopyMyStuff2()
    Dim wsSrc As Worksheet 'define source
    Set wsSrc = ThisWorkbook.Worksheets("SourceSheet")

    Dim wsDest As Worksheet 'define destination
    Set wsDest = ThisWorkbook.Worksheets("Sheet3")

    Dim FindList As Variant 'defind search words
    FindList = Array("Tank Engine", "Weatherman")

    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