Range.Find, чтобы вернуть правильное значение на основе критериев

Question

Я пытаюсь импортировать задачи с одного листа (WS) на основной лист трекера (подзадачи). Таблица импорта содержит вехи, а затем подзадачи в каждом вехе.

Мой код импортирует вехи, затем возвращается и импортирует подзадачи для каждого вехи. Однако, если добавляемые вехи имеют тот же заголовок, что и на листе «Подзадача», это добавит подзадачи к неверному этапу. Я использую Range.Find, я понимаю, что он найдет первое совпадение, которое я не хочу постоянно. Поэтому я хочу добавить критерии, поэтому, если совпадение, если найдено, и значение в столбце H равно значению в N9 на рабочем листе, а затем значение в столбце I подзадачи равно значению в значении N10 в WS, потом добавь.

Если нет, найдите следующее и повторите проверку. Тем не менее, я не могу заставить его работать.

ОБНОВЛЕНО

                If .Cells(findactivityintasks.row, TDSNumCol).Value = ImportWs.Range("N9").Value And .Cells(findactivityintasks.row, MileStoneNumCol).Value = DeliverableActivity Then
                    newdeliverablerow = (findactivityintasks.row)
                Else
                    Do
                        Set findactivityintasks = .Range("B3:B" & lastrowsubtasks1).FindNext(findactivityintasks)
                    Loop Until .Cells(findactivityintasks.row, TDSNumCol).Value = ImportWs.Range("N9").Value And .Cells(findactivityintasks.row, MileStoneNumCol).Value = DeliverableActivity
                    newdeliverablerow = (findactivityintasks.row)
                End If

ВСЕ КОД ДЛЯ SUB

'Add Milestone to subtask sheets
For Each cell In ImportWs.Range("B" & activityStart & ":B" & activityend)
NewRowSubTasks = lastrowsubtasks + i
DeliverableActivity = Int(cell.Offset(0, -1).Value)
    With subtaskws
        .Range(SubTaskCol & NewRowSubTasks & ":" & lastcollet & NewRowSubTasks).Interior.ColorIndex = 16
        .Range(SubTaskCol & NewRowSubTasks & ":" & lastcollet & NewRowSubTasks).Font.ColorIndex = 2
        .Range(SubTaskCol & NewRowSubTasks & ":" & lastcollet & NewRowSubTasks).Font.Size = 12
        .Range(IDCol & NewRowSubTasks).Interior.ColorIndex = 23
        .Range(IDCol & NewRowSubTasks).Font.ColorIndex = 2
        .Range(IDCol & NewRowSubTasks).Font.Size = 16
        .Range(IDCol & NewRowSubTasks).NumberFormat = "0"
        .Cells(NewRowSubTasks, SubTaskCol).Value = ImportWs.Range("B" & cell.row).Value
        .Cells(NewRowSubTasks, IDCol).Value = Application.WorksheetFunction.RoundUp((subtaskws.Range("A" & NewRowSubTasks - 1).Value + 0.01), 0)
        .Cells(NewRowSubTasks, TDSNumCol).Value = ImportWs.Range("N9").Value
        .Cells(NewRowSubTasks, MileStoneNumCol).Value = DeliverableActivity
        .Cells(NewRowSubTasks, BWLCol).Value = ImportWs.Range("L" & cell.row).Value
    End With
    i = i + 1
Next cell

'find start and end of deliverables
DeliverableStart = valuePos(ImportWs, "C:G", "Outputs / Deliverables") + 1
DeliverableEnd = valuePos(ImportWs, "A:G", "Tools / constraints") - 1


'find deliverables to add to Milestones and find what Milestones to add them too
For Each cell In ImportWs.Range("C" & DeliverableStart & ":C" & DeliverableEnd)
    DeliverableActivity = Int(cell.Offset(0, -1).Value)
    Set finddeliverableactivity = ImportWs.Range("A" & activityStart & ":A" & activityend).Find(What:=("# " & (DeliverableActivity + 1)), Lookat:=xlWhole)
        If finddeliverableactivity Is Nothing Then
            With subtaskws
                Dim lastrowsubtasks1 As Long
                lastrowsubtasks1 = subtaskws.Range("A" & Rows.Count).End(xlUp).row
                newdeliverablerow = (lastrowsubtasks1 + 1)
                .Range("A" & (newdeliverablerow)).EntireRow.Insert
                newrow = newdeliverablerow
                .Range("A4").EntireRow.Copy
                .Range("A" & newrow).EntireRow.PasteSpecial xlPasteFormulasAndNumberFormats
                .Range("A" & newrow).EntireRow.PasteSpecial xlPasteValidation
                .Range("A" & newrow).EntireRow.PasteSpecial xlPasteAllMergingConditionalFormats
                .Range("A" & newrow & ":AE" & newrow & "").ClearContents
                .Columns("A:BB").Calculate
                .Range(IDCol & newrow).Value = subtaskws.Range("A" & newrow).Offset(-1, 0).Value + 0.01
                .Cells(newrow, SubTaskCol).Value = cell.Value
                .Cells(newrow, FormatCol).Value = cell.Offset(0, 1).Value
                .Cells(newrow, AcceptanceCriteriacol).Value = cell.Offset(0, 2).Value
                .Cells(newrow, TargetDateCol).Value = cell.Offset(0, 9).Value
                .Cells(newrow, BWLCol).Value = cell.Offset(0, 7).Value
                .Cells(newrow, TDSNumCol).Value = ImportWs.Range("N9").Value
                .Cells(newrow, MileStoneNumCol).Value = DeliverableActivity
                .Cells(newrow, AWCol).Value = "=SUM(AF" & newrow & ":" & lastcollet & newrow & ")"
                .Cells(newrow, PCol).Value = "=(" & WCol & newrow & "*" & ICol & newrow & "*" & ECol & newrow & ")"
                .Cells(newrow, LevelCol).Value = "=IF(" & PCol & newrow & " >11,1,IF(" & PCol & newrow & ">3,2,""N/A""))"
                .Range("A" & newrow).EntireRow.Hidden = False
            End With
            Exit Sub
        Else
            With subtaskws
                lastrowsubtasks1 = subtaskws.Range("A" & Rows.Count).End(xlUp).row
                activityrow = finddeliverableactivity.row
                ActivtiyforDeliverable = ImportWs.Range("B" & activityrow).Value
                Set findactivityintasks = .Range("B3:B" & lastrowsubtasks1).Find(What:=(ActivtiyforDeliverable), Lookat:=xlWhole)
                newdeliverablerow = (findactivityintasks.row)
                .Range("A" & (newdeliverablerow)).EntireRow.Insert
                newrow = newdeliverablerow
                .Range("A4").EntireRow.Copy
                .Range("A" & newrow).EntireRow.PasteSpecial xlPasteFormulasAndNumberFormats
                .Range("A" & newrow).EntireRow.PasteSpecial xlPasteValidation
                .Range("A" & newrow).EntireRow.PasteSpecial xlPasteAllMergingConditionalFormats
                .Range("A" & newrow & ":AE" & newrow & "").ClearContents
                .Columns("A:BB").Calculate
                .Range(IDCol & newrow).Value = subtaskws.Range("A" & newrow).Offset(-1, 0).Value + 0.01
                .Cells(newrow, SubTaskCol).Value = cell.Value
                .Cells(newrow, FormatCol).Value = cell.Offset(0, 1).Value
                .Cells(newrow, AcceptanceCriteriacol).Value = cell.Offset(0, 2).Value
                .Cells(newrow, TargetDateCol).Value = cell.Offset(0, 9).Value
                .Cells(newrow, BWLCol).Value = cell.Offset(0, 7).Value
                .Cells(newrow, TDSNumCol).Value = ImportWs.Range("N9").Value
                .Cells(newrow, MileStoneNumCol).Value = DeliverableActivity
                .Cells(newrow, AWCol).Value = "=SUM(AF" & newrow & ":" & lastcollet & newrow & ")"
                .Cells(newrow, PCol).Value = "=(" & WCol & newrow & "*" & ICol & newrow & "*" & ECol & newrow & ")"
                .Cells(newrow, LevelCol).Value = "=IF(" & PCol & newrow & " >11,1,IF(" & PCol & newrow & ">3,2,""N/A""))"
                .Range("A" & newrow).EntireRow.Hidden = False
            End With
        End If

Next cell

Call CompactView

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic