Найти и скопировать определенные данные из найденного диапазона с другого листа

Question

Я имею дело с неорганизованными данными. Я работаю на содержит информацию о папке данных консолидированы и разделены, лист "FileListd". Например:

From: 158265 To: 52154 48546 514562 84562 158265
From: 48946 To: 52174 48946 515562 89562 158265
From: 52154 52174 48946 To: 515462 89572 48546

У меня есть список номеров папок, таких как: 52154 48546 514562 84562 158265 номеров из первой строки в столбце A1: A1000 в листе «Тест». Если мне нужно найти 52154 в консолидированном листе и найти «To:» в той же строке и скопировать данные рядом с «To:» в последний столбец из листа «FileListd» на лист «Test» .cel.offset (2 ).

Мне удалось привить макрокоманду ниже, которая работает при выполнении задачи первого этапа, которая заключается в том, чтобы найти нужное число в листе «FileListd» и определить область поиска для следующего поиска «Кому:». Но если в первом случае нет To: он ищет другой номер из списка. Я не мог заставить его искать тот же номер, пока «To:» не найден. В некоторых случаях «To:» вообще не найдено, поиск должен начинаться с другого номера в списке на листе «Test». Есть ли способ?

    Sub FurtherDataDigger()

    Dim mynum As Variant
    Dim startCell As Range
    Dim rng1 As Range
    Dim lastcol As Long
    Dim searchRange As Range
    Dim matchFound As Range
    Dim searchArea As Range
    Dim cel As Range

   With Sheets("Test")
   Set rng1 = .Range("A1:A1000")
   For Each cel In rng1
   If cel.Text <> "" Then
   mynum = cel.Text

  With Sheets("filelistd")
  Set searchArea = Sheets("Filelistd").UsedRange
    Set startCell = searchArea.Find(mynum, , xlValues, xlWhole, 
   xlByRows, xlNext, False)
   lastcol = 

 Sheets("Filelistd").UsedRange.SpecialCells(xlCellTypeLastCell).Column
  firstaddress = startCell.Address

     Set searchRange = Range(Cells(startCell.Row, 
   startCell.Column), Cells(startCell.Row, lastcol))
     Set matchFound = searchRange.Find("TO:", , xlValues, 
   xlPart, xlByRows, xlNext, False)

   If Not matchFound Is Nothing Then

        Do
     Sheets("Filelistd").Range(Cells(matchFound.Row, 
   matchFound.Column), Cells(matchFound.Row, lastcol)).Copy
    Sheets("Test").Range(cel.Offset(0, 2)).PasteSpecial 
   Transpose:=True
    If matchFound.Text = "" Then
    Set startCell = .FindNext(startCell)
    End If

   Set startCell = .FindNext(startCell)
   Loop While Not startCell Is Nothing And startCell.Address 
  <> firstaddress

    End If
   End With
   End If
   Next
   End With

End Sub