VBA to filter cut and paste

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

When I 'Dim FalsePositives As Worksheet' in the beginning I get a run time error 91 object variable or with block variable not set. — M1tch_8989

Unknown Unknown · Accepted Answer · 2018-08-01T18:01:06

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

VBA to filter cut and paste

1 Answers