Как мне изменить структуру макроса? Несколько .Find и .FindNext вызывают ошибку (VBA)

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

Все прошло хорошо, пока я не добавил еще одну функцию Find, и теперь она бросает ошибки. С некоторыми исследованиями я понял, что это потому, что у меня есть две функции Find, которые предположительно разрушают контекст для FindNext. Итак, я понимаю теорию, но я не знаю, как ее практически исправить.

Каковы некоторые альтернативы для работы моего кода?

Вот скриншоты и код для контекста:

введите описание изображения здесь

^ Основная книга, с листами Страх, Пол, Счастливый, RBL и WholeReport, которые имеют информацию по предметам

введите описание изображения здесь

^ Индийский список дел

введите описание изображения здесь ^ Журнал учета уборки Indiv

Код:

Sub FindTest() Dim wbMaster As Workbook Dim wbIndiv As Workbook Dim wsMaster, wsIndiv As Worksheet Dim wsICleaning As Worksheet Dim LastRow As Long Dim LastRowIndiv, LastRowIClean As Long Dim FoundRow, FoundCol As Long Dim FoundRow2 As Long Dim firstCellAddress As String Dim rgSearch As Range Dim aCell As Range Dim bCell As Range Dim MergeID As String Dim sourcePath As String: sourcePath = "C:\Cleaning_Notes_testing\" Dim strIndiv(1 To 3) As String Dim i, e Dim TaskString As String Set wbMaster = ActiveWorkbook Set wsMaster = wbMaster.Sheets("Data Tracking Log") LastRow = Range("A5000").End(xlUp).Row strIndiv(1) = "Christie" strIndiv(2) = "Brittany" strIndiv(3) = "Adeeb" For Each i In strIndiv If i <> "" Then With Workbooks.Open(sourcePath & "Cleaning_notes_" & i & ".xlsx") Debug.Print i Set wbIndiv = ActiveWorkbook Set wsIndiv = wbIndiv.Sheets("To-Do") Set wsICleaning = wbIndiv.Sheets("Cleaning Notes") ' Get search range Set rgSearch = wsMaster.Range("E1:L" & LastRow) Set aCell = rgSearch.Find(i) ' If not found then exit If aCell Is Nothing Then Debug.Print "Not found" Exit Sub End If ' Store first aCell address firstCellAddress = aCell.Address Debug.Print firstCellAddress ' Find all cells containing Name Do Debug.Print "Found: " & aCell.Address 'Populate To-Do FoundRow = aCell.Row Debug.Print "FoundRow: " & FoundRow FoundCol = aCell.Column Debug.Print "Found Col: " & FoundCol Set aCell = rgSearch.FindNext(After:=aCell) Debug.Print "Found: " & aCell.Address wsIndiv.Activate LastRowIndiv = wsIndiv.Range("A5000").End(xlUp).Row + 1 wsIndiv.Range("A" & LastRowIndiv).Value = wsMaster.Range("A" & FoundRow).Value wsIndiv.Range("B" & LastRowIndiv).Value = wsMaster.Range("C" & FoundRow).Value wsIndiv.Range("C" & LastRowIndiv).Value = wsMaster.Range("D" & FoundRow).Value wsIndiv.Range("D" & LastRowIndiv).Value = wsMaster.Cells(1, FoundCol).Value MergeID = wsIndiv.Range("A" & LastRowIndiv).Value Debug.Print MergeID TaskString = wsMaster.Cells(1, FoundCol).Value Debug.Print TaskString 'Populate indiv Cleaning Notes If TaskString = "Fear" Or TaskString = "Gender" Or TaskString = "Happy" Or TaskString = "RBL" Or TaskString = "WholeReport" Then wsICleaning.Activate LastRowIClean = Range("A5000").End(xlUp).Row + 1 wsICleaning.Range("A" & LastRowIClean).Value = wsMaster.Range("A" & FoundRow).Value wsICleaning.Range("B" & LastRowIClean).Value = wsMaster.Range("C" & FoundRow).Value wsICleaning.Range("C" & LastRowIClean).Value = wsMaster.Range("D" & FoundRow).Value wsICleaning.Range("D" & LastRowIClean).Value = TaskString wbMaster.Sheets(TaskString).Activate Set bCell = ActiveSheet.Columns(1).Find(What:=MergeID, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) FoundRow2 = bCell.Row Debug.Print "FoundRow2: " & FoundRow2 Debug.Print ActiveSheet.Range("G" & FoundRow2).Value wsICleaning.Range("E" & LastRowIClean).Value = ActiveSheet.Range("G" & FoundRow2).Value End If wsMaster.Activate Loop While firstCellAddress <> aCell.Address End With End If Next i End Sub 

Спасибо за ваше время!

Вам не хватает Find() перед завершением проверки цикла

  Set aCell = rgSearch.Find(What:=i, After:=aCell) Loop While firstCellAddress <> aCell.Address 
Давайте будем гением компьютера.