Private Sub Worksheet_Change(ByVal Target As Range)
    Dim idData As Range
    Set idData = Intersect(Target, Columns("b:b"))
    If Not idData Is Nothing Then
        Set shData = Sheets("Данные")
        For Each cell In idData
            If cell <> "" Then
                With shData
                    r = .Columns(1).Find(cell, , xlValues, xlWhole).Row
                    c = .Rows(1).Find("Столбец5", , xlValues, xlWhole).Column
                    Cells(cell.Row, "e").Resize(, 3) = .Cells(r, c + 1).Resize(, 3).Value
                End With
            Else
                Cells(cell.Row, "e").Resize(, 3).ClearContents 'если не надо, убрать
            End If
        Next cell
    End If
End Sub