Переместить строки на другой лист на основе списка ключевых слов

Question

Обнаружена ошибка в моем коде при попытке переместить строки на другой лист.

У меня есть список ключевых слов, которые я хотел бы найти в списке данных на листе «Сегодня». Если он найден в списке, он переместится на другой лист под названием «Исключение». У меня уже есть рабочий код, однако я сталкиваюсь с ошибкой «Выполнение кода было прервано».

Список данных, которые у меня есть, которые мне нужно искать по определенному ключевому слову:

| Assignee | Due on/At  | Attachment    | Subject Description |
|----------|------------|---------------|---------------------|
| Carl     | 16.11.2016 | No Attachment | Re: Information 1   |
| Clark    | 16.11.2016 | No Attachment | Test 4              |
| Kent     | 16.11.2016 | No Attachment | Test 6              |
| Japhet   | 16.11.2016 | No Attachment | Test 6              |
| Ryza     | 16.11.2016 | No Attachment | Re: Information 2   |
| Shane    | 16.11.2016 | No Attachment | FWD Subject 1       |
| Kent     | 16.11.2016 | No Attachment | Test 6              |
| Japhet   | 16.11.2016 | No Attachment | Test 6              |
| Ryza     | 16.11.2016 | No Attachment | FWD Subject 2       |
| Shane    | 16.11.2016 | No Attachment | Test 8              |
| Shane    | 16.11.2016 | No Attachment | Test 92             |
| Japhet   | 16.11.2016 | No Attachment | R:                  |
| Japhet   | 16.11.2016 | No Attachment | Test 92             |

Список ключевых слов, которые я установил:

| //// Exception Keywords |
|-------------------------|
| Re:                     |
| R:                      |
| FWD                     |
| Test                    |
| FW                      |

Ожидается, что он переместит все строки на другом листе, который содержит определенное ключевое слово, которое я перечислил. В этом случае это будут строки:

1. Re: Информация 1
2. Re: Информация 2
3. FWD Тема 1
4. FWD Тема 2

Кстати, список ключевых слов может расти.

Вот мой код:

Sub SeparateExceptionList()

Dim MainSheet as Worksheet
Dim TodaySheet as Worksheet
Dim excLastRow As Long
Dim tLastRow as Long
Dim i as long
Dim j as long

Set MainSheet = Sheets("Main")
Set TodaySheet = Sheets("Today")


tLastRow = TodaySheet.Cells(Rows.Count, 4).End(xlUp).Row
excLastRow = MainSheet.Cells(Rows.Count, 7).End(xlUp).Row

For j = 10 To excLastRow

exceptionKeyword = MainSheet.Cells(j, 7).Value

    For i = tLastRow To 2 Step -1

    If UCase(TodaySheet.Cells(i, 4)) Like "*" & UCase(exceptionKeyword) & "*" Then

        TodaySheet.Range("a" & i & ":D" & i).Copy Sheets("Exception").Range("ExceptionTable").ListObject.ListRows.Add.Range
        TodaySheet.Cells(i, 4).EntireRow.Delete '//This is where the code is being interrupted

        Else:

    End If

    Next i

Next j

End Sub