Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("AA3")) Is Nothing Then
    Application.EnableEvents = False
Dim FoundCell As Range
Dim FAdr As String
Dim FoundNomer As Range
Dim iLastRow As Integer
Dim iStart As Long
Dim iEnd As Long
Dim j As Integer
   iLastRow = Cells(Rows.Count, "AB").End(xlUp).Row + 1
   If iLastRow >= 4 Then Range("AB4:AD" & iLastRow).Clear
    Set FoundCell = Columns(5).Find("Обозн. исполн.", , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then         'нашли Обозн. исполн.
      FAdr = FoundCell.Address
      Do
        Set FoundNomer = Range(Cells(FoundCell.Row, "F"), Cells(FoundCell.Row, "O")).Find(Target, , xlValues, xlWhole)
         If Not FoundNomer Is Nothing Then   'нашли номер исполнения
           iStart = FoundCell.Row + 1
           Set FoundCell = Columns(5).Find("Обозн. исполн.", After:=FoundCell)
           If FoundCell.Address = FAdr Then
             iEnd = Cells(Rows.Count, "E").End(xlUp).Row
           Else
             iEnd = FoundCell.Row - 1
           End If
           For j = iStart To iEnd   'цикл по документации выбранного номера исполнения
             If IsNumeric(Cells(j, FoundNomer.Column)) Then
               iLastRow = Cells(Rows.Count, "AB").End(xlUp).Row + 1
               Cells(iLastRow, "AB") = Cells(j, "D")                 'чертеж
               Cells(iLastRow, "AC") = Cells(j, "E")                 'наименование
               Cells(iLastRow, "AD") = Cells(j, FoundNomer.Column)   'количество
             End If
           Next
             iLastRow = Cells(Rows.Count, "AB").End(xlUp).Row
             Range("AB4:AD" & iLastRow).Borders.Weight = xlThin      'границы
             Exit Do
         End If
         Set FoundCell = Columns(5).Find("Обозн. исполн.", After:=FoundCell)
      Loop While FoundCell.Address <> FAdr
     End If
 End If
  Application.EnableEvents = True
End Sub