VBA过滤剪切和粘贴

Question

一般来说，我是宏和 VBA 的新手。 只是试图自动化一些过滤，这将节省我大量的时间。 我一直在尝试使用 excel 中的宏来选择数据，按某些条件过滤（下面我将它放在一个过滤器上以方便）剪切，然后粘贴到新工作表。 我希望它也删除我从中剪切的空行。 下面的代码只复制不删除。

Sub filtertest()
Dim LastRow As Long

Sheets("Sheet1").Cells.Clear
Sheets("Sheet2").Activate

'Find the last row
LastRow = Range("A1").CurrentRegion.Rows.Count

'Select Table
Range("A1:K" & LastRow).Select

'Filter table
Selection.AutoFilter Field:=1, Criteria1:="51192"

'Copy/Paste
Selection.Copy
Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues

'Turn off autofilter
Selection.Autofilter

End Sub

我还尝试将一些其他代码组合在一起以将它们组合在一起。 但是，我不断收到有关对象的错误。 不确定是因为“sub button_click()”还是我所说的我是新手。 任何帮助表示赞赏。 谢谢！

Sub Button1_Click()

Application.ScreenUpdating = False
Columns(1).AutoFilter 1, "51192"
With Range("a1", Range("i" & Rows.Count).End(3))
    .Copy FalsePositives.Cells(Rows.Count, 1).End(3).Offset(1)
    .EntireRow.Delete
End With
Columns(1).AutoFilter
Application.ScreenUpdating = True

End Sub

Answer 1

复制并粘贴值，然后返回并删除原始文件，跳过标题。

Sub filtertest()
    Dim LastRow As Long

    Worksheets("Sheet1").Cells.Clear

    With Worksheets("Sheet2")

        'Find the last row
        LastRow = .Range("A1").CurrentRegion.Rows.Count

        'Filter table
        .Range("A1:K" & LastRow).AutoFilter Field:=1, Criteria1:="51192"


        'Copy/Paste
        .Range("A1:K" & LastRow).SpecialCells(xlCellTypeVisible).Copy
        Worksheets("Sheet1").Range("A1").PasteSpecial xlPasteValues

        'remove originals
        .Range("A1:K" & LastRow).Offset(1, 0).EntireRow.Delete

        'Turn off autofilter
        .AutoFilterMode = False
    End With
End Sub

Answer 2

我是论坛的新手。 我向大家打招呼。 我找到了您的过滤器并根据特定需要对其进行了修改。 我所做的是创建一个名为 AUXILIAR 的工作表，以复制应用的过滤器。 标准是ALTA这个词。 我的问题如下。 每次放ALTA这个词，文档就滞后； 也就是说，它不锁定，但写ALTA这个词需要时间。

我留下修改后的代码，以便您可以阅读它并帮助我找出为什么它滞后和变慢。

谢谢你们。

代码

Sub FiltroAvanzado()
 
'Nombramos las variables
 Dim UltimaFila As Long
 Dim UltimaFilaAuxiliar As Long
 
 
 With Worksheets("TRAFICO")

        'Encuentra la ultima fila
        UltimaFila = .Range("A3").CurrentRegion.Rows.Count

        'Filtra Tabla
        .Range("A2:I" & UltimaFila).AutoFilter Field:=9, Criteria1:="ALTA"
        
        
       
        
        'Copia/Pega
        .Range("A3:I" & UltimaFila).SpecialCells(xlCellTypeVisible).Copy
        
         UltimaFilaAuxiliar = Sheets("AUXILIAR").Columns("A").Find("*", _
         searchorder:=xlByRows, searchdirection:=xlPrevious).Row
         Worksheets("AUXILIAR").Range("A" & UltimaFilaAuxiliar + 1).PasteSpecial xlPasteValues

        'Remueve los valores originales
        .Range("A2:I" & UltimaFila).Offset(1, 0).EntireRow.Delete

        'Apaga el Auto Filtro
        .AutoFilterMode = False
    End With


End Sub

Answer 3

我发现了这个小论坛，我真的很喜欢它。 我能和你一起学习。 使用你的方法，但根据我的需要修改它。 我只有一个问题，我不知道如何解决。

我有 2 张工作表，一张是数据，另一张是我复制旧数据的地方，我保存了它。 我用ALTA这个词过滤。

我的问题是，当我写 ALTA 这个词时，excel 需要时间，它不会锁定，它很慢或滞后。 我留下代码让他们理解并告诉我怎么做，这样当我写ALTA这个词时，excel就不会滞后。

我还想告诉你，我把代码放在一个插件中，并在功能区上添加了一个按钮，以便它在我需要的时候执行代码。

你好。

Sub FiltroAvanzado()

Dim UltimaFila As Long Dim UltimaFilaAuxiliar As Long

'Esta instruccion limpia la hora a donde se enviaran los datos
'desactivamos la intruccion para otra ocacion
'Worksheets("AUXILIAR").Cells.Clear

With Worksheets("TRAFICO")

    'Encuentra la ultima fila
    UltimaFila = .Range("A3").CurrentRegion.Rows.Count

    'Filtra Tabla
    .Range("A2:I400" & UltimaFila).AutoFilter Field:=9, Criteria1:="ALTA"
    
    
   
    
    'Copia/Pega
    .Range("A3:I" & UltimaFila).SpecialCells(xlCellTypeVisible).Copy
    
     UltimaFilaAuxiliar = Sheets("AUXILIAR").Columns("A").Find("*", _
     searchorder:=xlByRows, searchdirection:=xlPrevious).Row
     Worksheets("AUXILIAR").Range("A" & UltimaFilaAuxiliar + 1).PasteSpecial xlPasteValues

    'Remueve los valores originales
    .Range("A2:I" & UltimaFila).Offset(1, 0).EntireRow.Delete

    'Apaga el Auto Filtro
    .AutoFilterMode = False
End With

结束子