Sub svodka()

Dim WS As Worksheet
Dim Target As Range
Dim CellData As Range
Dim CellsVoditel As Range

Set CellData = Worksheets("DATA").Range("A2:H500")
Set CellsVoditel = ActiveSheet.Range("E2:E500")

    For Each WS In ThisWorkbook.Worksheets
      'исключаем лист с данными с именем "DATA"
       If WS.Name <> "DATA" Then
                       
                If Not Application.Intersect(ActiveCell, Range(CellsVoditel.Address)) Is Nothing Then
                       For Each cell In CellsVoditel
                            If cell.Value <> "" Then
                                    cell.Offset(0, -4).Value = Application.VLookup(cell, CellData, 2, False)
                                    cell.Offset(0, -1).Value = Application.VLookup(cell, CellData, 3, False)
                                    cell.Offset(0, 1).Value = Application.VLookup(cell, CellData, 4, False)
                                    cell.Offset(0, 2).Value = Application.VLookup(cell, CellData, 5, False)
                               Else
                                    cell.Offset(0, -4).Value = ""
                                    cell.Offset(0, -1).Value = ""
                                    cell.Offset(0, 1).Value = ""
                                    cell.Offset(0, 2).Value = ""
                            End If
                        Next cell
                End If
        End If
    Next
End Sub