尝试将行移到另一个工作表时遇到代码错误。
我需要查找某个关键字的数据列表:
| 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
-
回复:信息2
-
-
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
