Копирование строки по условию vba excel

Sub Программа()

        Dim shSrc As Worksheet, arrSrc()
    Dim shRes As Worksheet, arrRes(), r As Long
    Dim strFN_src As String
    Dim lr As Long, i As Long

            ‘1. Юзер выбирает файл-источник.
    strFN_src = GetFilePath
    If strFN_src = «» Then Exit Sub

        ‘2. Отключение монитора, чтобы ускорить работу макроса и чтобы меньше мигало.
    Application.ScreenUpdating = False

        ‘3. Присваивание листу-результату имени «shRes». Затем через это имя удобно обращаться к листу в коде.
    Set shRes = ActiveSheet

        ‘4. Открытие файла-источника.
        ‘ Листу «свод» присваивается имя «shSrc».
        ‘ ReadOnly:=True — нам нужно открыть только для чтения. Это может чем-нибудь упростить макрос.
    Set shSrc = Workbooks.Open(Filename:=strFN_src, ReadOnly:=True).Worksheets(«свод»)

        ‘5. Копирование некоторых данных из листа-источника в массив. С массивом быстрее работать, чем с эксель-ячейками.
        ‘ На листе не должно быть скрытых строк, иначе некоторые строки могут быть не учтены.
    lr = shSrc.Cells(shSrc.Rows.Count, «A»).End(xlUp).Row
    arrSrc() = shSrc.Range(«A1:C» & lr).Value

        ‘6. Создание ячеек в массиве-результате. Сначала в него запишутся данные, а затем он
        ‘ будет вставлен на эксель-лист. Это ускорит работу макроса.
        ‘ Строк создаётся максимально возможное кол-во, т.к. заранее не известно, сколько будет строк с данными.
    ReDim arrRes(1 To UBound(arrSrc, 1), 1 To 3)

        ‘7. Копирование данных из листа-источника в массив-результат.
    For i = 5 To UBound(arrSrc, 1)
        If (arrSrc(i, 1) = 1) And (arrSrc(i, 3) = «ВСЕГО») Then
            r = r + 1
            arrRes(r, 1) = arrSrc(i, 1)
            arrRes(r, 2) = arrSrc(i, 2)
            arrRes(r, 3) = shSrc.Cells(i, «P»).Value
        End If
    Next i

        ‘8. Закрытие файла-источника.
    shSrc.Parent.Close SaveChanges:=False

        ‘9. Действия, если не было найдено нужных строк.
    If r = 0 Then
        Application.ScreenUpdating = True
        MsgBox «В файле-источнике нет нужных данных.», vbExclamation
        Exit Sub
    End If

        ’10. Вставка данных на лист-результат.
    shRes.Range(«A3»).Resize(r, UBound(arrRes, 2)).Value = arrRes()

        ’11. Включение монитора.
    Application.ScreenUpdating = True

        ’12. Сообщение, чтобы было понятно, что программа завершила работу.
    MsgBox «Готово.», vbInformation

    End Sub

Private Function GetFilePath() As String

        Const sTitle As String = «Выберите файл КДРО»
    Const sInitialPath As String = «c:»
    Const sFilterDescription As String = «Книги Excel»
    Const sFilterExtention As String = «*.xls*»

        With Application.FileDialog(msoFileDialogOpen)
        .ButtonName = «Выбрать»: .Title = sTitle: .InitialFileName = sInitialPath
        .Filters.Clear: .Filters.Add sFilterDescription, sFilterExtention

                If .Show = 0 Then Exit Function

                GetFilePath = .SelectedItems(1)

            End With

    End Function

[свернуть]

Sub Yana_Zhilak() 
Dim LastRow As Long, Rw As Long 'Объявили переменный послдедних строк для двух слистов
LastRow = Cells(Rows.Count, 1).End(xlUp).Row 'Нашли номер последней строки на активном листе (там, где кнопка)
With Sheets("Лист2") 'Применительно к Лист2
Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1 'Нашли номер первой свободной строки на этом листе
Range(.Cells(4, 1), .Cells(Rw + 1, 5)).ClearContents 'Очистили ПОЛНОСТЬЮ диапазон на втором листе
Rw = 7 'Указали, что первая свободная строка =7
For i = 7 To LastRow 'Цикл со строки № 7 по последнюю заполненную (на активном листе)
If Cells(i, 8) = "ЗБС" Then 'Если ячейка столбца 8 текущей строки = "ЗБС", то
Range(Cells(i, 1), Cells(i, 44)).Copy .Cells(Rw, 1) 'Дипазон (текущая строка, столбцы 1:44) копируем в первую свободную ячейку второго листа
Rw = Rw + 1 'Увеличивем переменную-счётчик первой свободной строки второго листа
End If
Next
End With
End Sub

Всем доброго времени суток. Пытаюсь написать макрос на VBA для Excel для переноса строки из таблицы на одном листе на другой при вводе в определенный столбец определенных данных. Написал обработчик события:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim table1 As ListObject, table2 As ListObject, table3 As ListObject

    Set table1 = Application.ThisWorkbook.Worksheets("Имя листа").ListObjects("Таблица1")
    Set table2 = Application.ThisWorkbook.Worksheets("Имя листа").ListObjects("Таблица2")
    Set table3 = Application.ThisWorkbook.Worksheets("Имя листа").ListObjects("Таблица3")
    
    If Target.Count > 1 Then
        Exit Sub
    End If
    
    If Application.Intersect(Target, table1.ListColumns(2)) Then
        If Target.Value = "Îòâàë" Then
            removeFailed (Target.EntireRow)
        End If
        Exit Sub
    
    ElseIf Application.Intersect(Target, table2.ListColumns(2).Range) Then
        If Target.Value = "Условие" Then
            removeFailed (Target.EntireRow)
        End If
        Exit Sub
    
    ElseIf Application.Intersect(Target, table1.ListColumns(2).Range) Then
        If Target.Value = "Условие" Then
            removeFailed (Target.EntireRow)
        End If
        Exit Sub
    
    Else
        Exit Sub
    
    End If
End Sub

и саму функцию, которая осуществляет перенос:

Function removeFailed(targetRow As Range)
    Dim l
    
    targetRow.Select
    Selection.Copy
    Application.ThisWorkbook.Worksheets("Имя листа назначения").Select
    l = Application.ThisWorkbook.Worksheets("Имя листа назначения").ListObjects("Таблица назначения").Range.End(xlDown)
    Rows(l & ":" & l).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Application.ThisWorkbook.Worksheets("Имя листа").Select
    targetRow.Delete
End Function

При выполнении вылетает ошибка «Type Missmatch». Подскажите пожалуйста советом, что я сделал неверно и как исправить все так, чтобы скрипт выполнял необходимые действия. Заранее большое спасибо!