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("Столбец3", , xlValues, xlWhole).Column
                    Cells(Cell.Row, "c").Resize(, 3) = .Cells(r, c + 1).Resize(, 3).Value
                End With
            Else
                Cells(Cell.Row, "c").Resize(, 3).ClearContents 'если не надо, убрать
            End If
        Next Cell
    End If
End Sub