Excel& VBA：根据单元格值将行复制到新的工作表中 [英] Excel & VBA: Copy rows into a new sheet based on cell value

问题描述

我是Excel和VBA中的新手。
我有一张这样的表：

  ABCD 
 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行复制到新表中，

如何做？

解决方案

p>如前面的注释所述，这是你如何过滤〜>复制〜>粘贴

  Sub FilterAndCopy（）
 
 Application.ScreenUpdating = False 
 Application.EnableEvents = False 
 Application.Calculation = xlCalculationManual 
 
 
 Dim lngLastRow As Long 
 Dim OKSheet作为工作表，ErrorSheet作为工作表
 
设置OKSheet = Sheets（Sheet2）'Set T他的工作表名称你想要所有的Ok将要
设置ErrorSheet =表（Sheet3）'将此设置为工作表名称你想要所有错误的
 
 lngLastRow =单元格（行） .Count，A）。End（xlUp）.Row 
 
 
带范围（A1，D& 
 .AutoFilter 
 .AutoFilter字段：= 4，Criteria1：=OK
 .Copy OKSheet.Range（A1）
 .AutoFilter字段：= 4， Criteria1：=ERROR
 .Copy ErrorSheet.Range（A1）
 .AutoFilter 
结束
 
 
 Application.ScreenUpdating = True 
 Application.EnableEvents = True 
 Application.Calculation = xlCalculationAutomatic 
 
 End Sub 
  

I'm a total newbie in Excel and VBA. I have a sheet like this:

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.

How can I do that?

解决方案

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

这篇关于Excel& VBA：根据单元格值将行复制到新的工作表中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！