VBA複数の条件が満たされた場合に、新しく作成されたシートに行をコピー

Question

「C」列を検索したい場合は、単語の最初の文字がAまたはMで始まらない場合は、行全体を編集し、新しく作成したワークシートに同じ書式で貼り付けます。残りの行を別の新しいワークシートにコピーしたいと思います。

これは私が使用しているコードで、いくつかのソースを参照しましたが、目的の結果が得られません。これまでは、新しいワークシートを作成し、「Rejected」ワークシートにコピーすることしかできませんでしたが、すべてをコピーして基準が機能していないようです。

Sub sortfunds() 

Worksheets.Add(Before:=Worksheets(Worksheets.Count)).Name = "Rejected" 
Worksheets.Add(Before:=Worksheets(Worksheets.Count)).Name = "Accepted" 

Dim wRejected As Worksheet 
Dim wAccepted As Worksheet 
Dim ws As Worksheet 
Dim LastRow As Long 
Dim i As Long 
Dim j As Long 
*'j is for 'Accepted' worksheet which I have not worked on yet* 

Set ws = ActiveSheet 
Set wRejected = ThisWorkbook.Sheets("Rejected") 
Set wAccepted = ThisWorkbook.Sheets("Accepted") 

With Application 
    .ScreenUpdating = False 
    .Calculation = xlCalculationManual 
End With 

LastRow = Range("C" & Rows.Count).End(xlUp).Row 

With ws 
    For i = LastRow To 1 Step -1 
     If Left(Range("C" & LastRow), 1) <> "A" And Left(Range("C" & LastRow), 1) <> "M" Then Rows(i).Copy wRejected.Rows(wRejected.Cells(wRejected.Rows.Count, 3).End(xlUp).Row + 1) 
    Next i 
End With 

With Application 
    .ScreenUpdating = True 
    .Calculation = xlCalculationAutomatic 
End With 

End Sub 

Answer 1

各行を順番に処理するのではなく、最後の行の値を常にチェックしています。

変更：

If Left(Range("C" & LastRow), 1) <> "A" And Left(Range("C" & LastRow), 1) <> "M" 

に：魅力のような

If Left(Range("C" & i), 1) <> "A" And Left(Range("C" & i), 1) <> "M"