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

VBA过滤剪切和粘贴

1 个答案: