Function FindWhole(Optional ByVal sWhole As String, Optional rngColumn As Range, Optional ByVal refresh As Boolean)
Static d: Dim a, i As Long, x
FindWhole = Array()
If TypeName(d) <> "Dictionary" Then
  Set d = CreateObject("Scripting.Dictionary"): d.CompareMode = 1
  refresh = 1
End If
If refresh Then
  d.RemoveAll
  If rngColumn Is Nothing Then Exit Function Else a = rngColumn.Resize(, 1).Value
  For Each x In a: i = i + 1: d(x) = d(x) & " " & i: Next
End If
If d.Exists(sWhole) Then FindWhole = Split(Trim(d(sWhole)))
End Function

Function FindInField(Optional ByVal sWhole As String, Optional ByVal sName As String, Optional rngColumn As Range, Optional ByVal refresh As Boolean)
Static d: Dim a, i As Long, x
FindInField = Array()
If TypeName(d) <> "Dictionary" Then Set d = CreateObject("Scripting.Dictionary"): d.CompareMode = 1
If sName = "" Then Exit Function
If TypeName(d(sName)) <> "Dictionary" Then
  Set d(sName) = CreateObject("Scripting.Dictionary")
  d(sName).CompareMode = 1
  refresh = 1
End If
If refresh Then
  d(sName).RemoveAll
  If rngColumn Is Nothing Then Exit Function Else a = rngColumn.Resize(, 1).Value
  For Each x In a: i = i + 1: d(sName)(x) = d(sName)(x) & " " & i: Next
End If
If d(sName).Exists(sWhole) Then FindInField = Split(Trim(d(sName)(sWhole)))
End Function

Sub FindInFieldApply()
Dim a, sWhole As String, sName As String, rngColumn As Range, refresh As Boolean
sWhole = "воздевать"
sName = "СписокСлов1" 'Называете как хотите, что по этому имени к нему обращаться
Set rngColumn = Range("Table1")
a = FindInField(sWhole, sName, rngColumn)
MsgBox "Номера строк внутри диапазона: " & Join(a, ", ")
End Sub

Optional ByVal refresh As Boolean

Static d

Public Sub www()
    Dim a
    a = Application.Transpose([a1].CurrentRegion.Value)
    a = Filter(a, "абор")
    ThisWorkbook.Worksheets(2).Cells(7, 4).Resize(UBound(a)) = Application.Transpose(a)
End Sub

Workbooks("Book1").Worksheets("Sheet1").UsedRange.Value = Workbooks("Book2").Worksheets("Sheet2").UsedRange.Value