VBA如果满足多个条件,则将行复制到新创build的工作表

我想search一个列“C”,如果单词的第一个字母不是以A或M开头,那么我想复制整行并粘贴到一个新创build的工作表中,格式相同。 我也想复制剩余的行到另一个新的工作表。

这是我已经使用的代码,并提到了几个来源,但我不能得到预期的结果。 到目前为止,我只能创build新的工作表,并复制到工作表“拒绝”,但它复制的一切,标准似乎并没有工作。

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 

您总是检查最后一行中的值,而不是依次处理每一行。

更改:

 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"