Question

我是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”行复制到一个新的工作表中，将“ERROR”复制到另一个工作表中。

我该怎么做？

Answer 1

如前面的评论中所述，这是你如何过滤〜＆gt;复制〜＆gt;粘贴

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

Answer 2

尝试这样的事情......

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

您需要更改数据来自的行/列以满足您的需求，但我根据您的示例编写了此内容。

修改第二个想法，我做了一些关于过滤器的阅读，我会选择其他人发布的内容。

Excel＆amp; VBA：根据单元格值将行复制到新工作表中

2 个答案: