VBA过滤剪切和粘贴

Question

I am new to macros and VBA in general. Just trying to automate some filtering that would save me a ton of time. I have been trying to work on a macro within excel to select data, filter on certain criteria (below i have it on one filter for ease) cut, and then paste to a new sheet. I want it to also delete the empty rows from which I cut from. The code below only copies and does not delete.

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

I also tried to mesh some other code together for this to combine it all. However I keep getting errors about an object. Not sure if it is because of the "sub button_click()" or what as I said I am new to this. Any help is appreciated. Thanks!

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

Copy and paste the values then return and delete the originals, skipping the header.

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

I'm new to the forum. I greet everyone. I found your filter and modified it for a specific need. What I did was create a sheet called AUXILIAR, to copy the applied filter. The criterion is the word ALTA. My problem is the following. Every time I put the word ALTA, the document lags; that is, it does not lock but it takes time to write the word ALTA.

I leave the modified code so that you can read it and help me find why it lags and gets slow.

Thank you all.

CODE

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

I found this little forum and I really liked it. I was able to learn with you. Use your methodology, but modify it to my need. I just have one problem that I don't know how to fix.

I have 2 Sheet, one with the data and another where I copy the old data, I save it. I filter with the word ALTA.

My problem is that when I write the word ALTA the excel takes time, it does not lock up, it is slow or laggy. I leave the code so that they understand it and tell me how to do it, so that when I write the word ALTA, the excel does not lag.

I also want to tell you, that I put the code in a plugin and add a button on the ribbon so that it executes the code when I need it.

Greetings.

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

End Sub