Excel 和 VBA：根据单元格值将行复制到新工作表中
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/17070625/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel & VBA: Copy rows into a new sheet based on cell value
提问by net.cat
I'm a total newbie in Excel and VBA. I have a sheet like this:
我是 Excel 和 VBA 的新手。我有一张这样的表：
A B C D
someinfo someinfo someinfo OK
someinfo someinfo someinfo OK
someinfo someinfo someinfo ERROR
someinfo someinfo someinfo ERROR
someinfo someinfo someinfo OK
someinfo someinfo someinfo OK
someinfo someinfo someinfo ERROR
someinfo someinfo someinfo ERROR
Ok I'd like to copy the "OK" lines into a new sheet and the one with "ERROR" into another one.
好的，我想将“OK”行复制到新工作表中，将带有“ERROR”的行复制到另一张工作表中。
How can I do that?
我怎样才能做到这一点？
回答by user2140261
As stated in earlier comments this is how you would Filter~>Copy~>Paste
正如之前的评论中所述，这就是您过滤~>复制~>粘贴的方式
Sub FilterAndCopy()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim lngLastRow As Long
Dim OKSheet As Worksheet, ErrorSheet As Worksheet
Set OKSheet = Sheets("Sheet2") ' Set This to the Sheet name you want all Ok's going to
Set ErrorSheet = Sheets("Sheet3") ' Set this to the Sheet name you want all Error's going to
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
With Range("A1", "D" & lngLastRow)
.AutoFilter
.AutoFilter Field:=4, Criteria1:="OK"
.Copy OKSheet.Range("A1")
.AutoFilter Field:=4, Criteria1:="ERROR"
.Copy ErrorSheet.Range("A1")
.AutoFilter
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub
回答by Al.Sal
Try something like this...
尝试这样的事情......
Set sh = ThisWorkbook.Sheets("Sheet1")
Set sh2 = ThisWorkbook.Sheets("Sheet2")
Set sh3 = ThisWorkbook.Sheets("Sheet3")
lastrow = sh.Cells(Rows.Count, "A").End(xlUp).row
R = 2
Do While R <= lastrow
If sh.Range("D" & R) = "OK" Then
sh.Range("A" & R & ":D" & R).Copy _
Destination:=sh2.Range("A" & R)
Else
sh.Range("A" & R & ":D" & R).Copy _
Destination:=sh3.Range("A" & R)
End IF
Loop
You would need to change the rows/columns the data is coming from to suit your needs, but I wrote this based off your example.
您需要更改数据来源的行/列以满足您的需要，但我根据您的示例编写了此内容。
EDIT:On second thought, I did some reading about filters and I would go with what others here have posted.
编辑：再想一想，我读了一些关于过滤器的书，我会选择这里其他人发布的内容。
