[英]VBA Copy rows to a newly created sheet if multiple criteria met
I would like to search a column, "C", and if the first letter of the word does not start with A or M, then I would like to copy the entire row and paste it in a newly created worksheet, with the same formatting. 我想搜索列“ C”,如果单词的第一个字母不是以A或M开头,那么我想复制整行并将其粘贴到新创建的工作表中,格式相同。 I would also like to copy the remaining rows into another new worksheet. 我还想将剩余的行复制到另一个新的工作表中。
This is the code that I have used and have referred to several sources but I can't get the desired results. 这是我使用过的代码,已引用了多个资源,但无法获得预期的结果。 So far, I am only able to create the new worksheets, and copy into the worksheet "Rejected", however it copies everything and the criteria does not seem to work. 到目前为止,我只能创建新的工作表,然后将其复制到“已拒绝”工作表中,但是它复制了所有内容,并且标准似乎不起作用。
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
You are always checking the values in the last row instead of working through each row in turn. 您总是在检查最后一行中的值,而不是依次浏览每一行。
Change: 更改:
If Left(Range("C" & LastRow), 1) <> "A" And Left(Range("C" & LastRow), 1) <> "M"
to: 至:
If Left(Range("C" & i), 1) <> "A" And Left(Range("C" & i), 1) <> "M"
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.