スキルアップ・問題解決なら、モーグにおまかせ！

お世話になります。Like演算子について質問です。
下記のコードで、"抽出ワード"シートを活用し、別シートへ「末尾の文字を含む」抽出はできたのですが、含まない抽出をしたいのですが、　If .Cells(r1, 4).Value Like "*" & tbl(i, 1) ThenをIfNot（ .Cells(r1, 4).Value Like "*" & tbl(i, 1) ）Thenにしてもうまくいきません…Elseをつかってシート足すにもうまく機能してくれないので、アドバイスを頂けたら、幸いです。
 
したい事：
抽出元は、5行目からデータがあります。
抽出場所は、D列の数値と英字があり、抽出ワードは、英字と数字となります。（A列に記載）
抽出場所は、抽出先は5行目以降に抽出したいです。
 
 
Sub test()
　Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
　Dim tbl As Variant
　Dim i As Long
　Dim r1 As Long, r3 As Long
　Dim ctbl As Variant
　Dim j As Integer
　ctbl = Array(3, 4, 7, 8, 14)
 
Application.ScreenUpdating = False
 
　r3 = 4
　Set ws1 = Worksheets("抽出元")
　Set ws2 = Worksheets("抽出先")
　Set ws3 = Worksheets("抽出ワード")
 
With ws2
　If .Cells(5, 1).Value <> "" Then
　　.Range("A5:E" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
　End If
End With
 
With ws3
　tbl = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
 
With ws1
　For r1 = 5 To .Cells(Rows.Count, 5).End(xlUp).Row
　　For i = 1 To UBound(tbl)
　　　If .Cells(r1, 4).Value Like "*" & tbl(i, 1) Then
　　　　r3 = r3 + 1
　　　　　For j = 0 To 4
　　　　　　ws2.Cells(r3, j + 1).Value = .Cells(r1, ctbl(j)).Value
　　　　　Next j
　　　End If
　　Next i
　Next r1
End With
 
Application.ScreenUpdating = True
End Sub

末尾に含まないなら今の方式でよいでしょう。
位置を問わずなら、
"*" & tbl(i, 1) & "*"
と比較します。

Simpleさんご返信ありがとうございます。
抽出ワードが含まないのを抽出先に出したいのですが、いまのコードですと、末尾に抽出ワードがあるのが、抽出先に抽出されてしまいます…

通じなかったようです。もう一度。
 
末尾に含まないなら、今のトライ式

If Not（ .Cells(r1, 4).Value Like "*" & tbl(i, 1) ）Then

If Not（ .Cells(r1, 4).Value Like "*" & tbl(i, 1) & "*"  ）Then

それでやると、同じ値がなん個も表示されるのですが、どこかコードが悪さをしてるのでしょうか…？

焦点となっているポイントしか見ておりません。
 
仕様をもう一度明確に書いてもらえますか？

引用:
したい事：
抽出元は、5行目からデータがあります。
抽出場所は、D列の数値と英字があり、抽出ワードは、英字と数字となります。（A列に記載）
抽出場所は、抽出先は5行目以降に抽出したいです。

If Not（ .Cells(r1, 4).Value Like "*" & tbl(i, 1) ）Thenで、下記のコードで実行すると、
Sub test()
　Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
　Dim tbl As Variant
　Dim i As Long
　Dim r1 As Long, r3 As Long
　Dim ctbl As Variant
　Dim j As Integer
　ctbl = Array(3, 4, 7, 8, 14)
  
Application.ScreenUpdating = False
  
　r3 = 4
　Set ws1 = Worksheets("抽出元")
　Set ws2 = Worksheets("抽出先")
　Set ws3 = Worksheets("抽出ワード")
  
With ws2
　If .Cells(5, 1).Value <> "" Then
　　.Range("A5:E" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
　End If
End With
  
With ws3
　tbl = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
  
With ws1
　For r1 = 5 To .Cells(Rows.Count, 5).End(xlUp).Row
　　For i = 1 To UBound(tbl)
　　　If Not（ .Cells(r1, 4).Value Like "*" & tbl(i, 1) ）Then
　　　　r3 = r3 + 1
　　　　　For j = 0 To 4
　　　　　　ws2.Cells(r3, j + 1).Value = .Cells(r1, ctbl(j)).Value
　　　　　Next j
　　　End If
　　Next i
　Next r1
End With
  
Application.ScreenUpdating = True
End Sub
 
抽出元データの5行目以降のデータが、1つの値が28個ずつコピーして、抽出され、抽出先に表示されます。
また、抽出ワードを含むまないものだけを抽出したいのですが、上記のコードですと、抽出ワード関係なく、28個ずつ増えて、抽出先に抽出されます。
 
 
例：
抽出元　D5の値が、1234567890とすると
抽出先　B5からB31まで123467890が繰り返し抽出されてます。
 
やりたいことは、抽出ワードに1,2,AからZの数英字をA列に格納してあります（28個）、抽出元D列の末尾に1,2,AからZの数英字を含まないものを抽出したいです。
 
抽出元　D5の値が、1234567890とすると
抽出先　B5に123467890抽出し、
抽出元　D6の値が、1234567890Aとすると、抽出はしないという風にしたいのですが、、、、
 
多分、28個コピーされているので、抽出ワードをループして数ぶん抽出しているように思えるのですが…

あれ、直ぐに返事があるかと思っていましたが。
 
否定をANDでつないでもいいですし、以下のような書き方もできるでしょう。

Sub test()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim tbl     As Variant
    Dim i       As Long
    Dim r1      As Long
    Dim r3      As Long
    Dim ctbl    As Variant
    Dim j       As Integer
    Dim matchflag As Boolean

    Application.ScreenUpdating = False

    Set ws1 = Worksheets("抽出元")
    Set ws2 = Worksheets("抽出先")
    Set ws3 = Worksheets("抽出ワード")

    '書き込み先のクリアー
    With ws2
        If .Cells(5, 1).Value <> "" Then
            .Range("A5:E" & .Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
        End If
    End With

    '文字列テーブル
    tbl = ws3.Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)

    '抽出
    ctbl = Array(3, 4, 7, 8, 14)
    r3 = 4
    With ws1
        For r1 = 5 To .Cells(Rows.Count, 5).End(xlUp).Row
            matchflag = False
            For i = 1 To UBound(tbl)
                If .Cells(r1, 4).Value Like "*" & tbl(i, 1) Then
                    matchflag = True
                    Exit For
                End If
            Next i
            If matchflag = False Then
                r3 = r3 + 1
                For j = 0 To 4
                    ws2.Cells(r3, j + 1).Value = .Cells(r1, ctbl(j)).Value
                Next j
            End If
        Next r1
    End With
    Application.ScreenUpdating = True
End Sub

昨日は野暮用がありご返信が遅れて申し訳ありません…
Simpleさんのコードでできました！とても参考になりました！
いつもありがとうございます！また色々とわからない事がありましたら、質問することもありますが、何卒よろしくお願いいたします。