Question

我有这个代码可以自动过滤我需要的数据并将其导出到新的工作簿。但是，我需要将它导出到同一工作簿中的新工作表中。有什么办法可以解决这个问题吗？我目前正在使用此代码：

Sub TestFilter()
Range("D1").AutoFilter Field:=4, Criteria1:="In Scope"
Range("M1").AutoFilter Field:=13, Criteria1:="NOT ASSIGNED"
Range("AG1").AutoFilter Field:=33, Criteria1:="Opening"
ActiveSheet.AutoFilter.Range.Copy
Workbooks.Add.Worksheets(1).Paste
Cells.AutoFilter
End Sub

谢谢！

Answer 1

像这样的东西（你应该编辑你正在过滤的范围）

Sub TestFilter()

Dim ws As Worksheet
Dim ws2 As Worksheet

Set ws = ActiveSheet
ws.AutoFilterMode = False

With ws.Range("A1:AZ100")
    .AutoFilter 4, "In Scope"
    .AutoFilter 13, "NOT ASSIGNED"
    .AutoFilter 33, "Opening"
End With
ws.AutoFilter.Range.Copy
Set ws2 = Sheets.Add(, , Sheets.Count)
ws2.Paste

ws.AutoFilterMode = False
Application.CutCopyMode = False

End Sub

Answer 2

您可以尝试这样的事情（Excel 2013）：

Sub Macro1()

    ' set up auto-filter for testing
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AG$3000").AutoFilter Field:=1, Criteria1:="John"   ' firstname
    ActiveSheet.Range("$A$1:$AG$3000").AutoFilter Field:=2, Criteria2:="Smith"  ' lastname

    ' copy filtered data by doing CTRL + right-arrow and then CTRL + down arrow
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    ' add a sheet after the existing one and paste values
    Sheets.Add After:=ActiveSheet
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

End Sub

Answer 3

我根据以下假设（符合提供的代码）提出以下代码：

包含源数据的工作表已激活
数据源已经过滤，否则在所提供的代码中应用的过滤器将无法在所有情况下使用。

如果不是这种情况，我们需要识别和过滤源数据，以下内容也适用：

数据源从单元格A1开始（根据第一个过滤器：Range("D1").AutoFilter Field:=4）
数据源至少转到第33栏（按照第三个过滤器：Range("AG1").AutoFilter Field:=33）

代码

Option Explicit

Sub Wsh_CopyFilteredSourceDataToNewWorksheet()
Rem Define variables to work with the Worksheets and Range
Const kColLast = 33
Dim WshSrc As Worksheet
Dim WshTrg As Worksheet
Dim RngSrc As Range

    Set WshSrc = ActiveSheet
    Set WshTrg = WshSrc.Parent.Sheets.Add(After:=WshSrc)

    Rem (1) Set AutoFilter for SourceData starting at "A1"
    With WshSrc
        Rem Reset AutoFilter for Source Worksheet
        If Not (.AutoFilter Is Nothing) Then .Cells(1).AutoFilter
        If .UsedRange.SpecialCells(xlLastCell).Column < kColLast Then
            .Cells(1, kColLast).Value = "Fld." & kColLast
            .Range(.Cells(1), .Cells(.UsedRange.SpecialCells(xlLastCell).Row, kColLast)).AutoFilter
        Else
            .Range(.Cells(1), .UsedRange.SpecialCells(xlLastCell)).AutoFilter
        End If

        Rem Set Filters
        With .AutoFilter.Range
            .AutoFilter Field:=4, Criteria1:="In Scope"
            .AutoFilter Field:=13, Criteria1:="NOT ASSIGNED"
            .AutoFilter Field:=33, Criteria1:="Opening"
    End With: End With

    Rem Copy Filtered Source Data to New Worksheet
    Set RngSrc = WshSrc.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
    With WshTrg.Cells(1)
        RngSrc.Copy
        Rem As per code provided
        .PasteSpecial
        Rem Since we are copying only partial worksheet data I suggest to use the following
        .PasteSpecial xlPasteFormulasAndNumberFormats
        Rem Always Reset CutCopyMode
        Application.CutCopyMode = False
    End With
    WshTrg.UsedRange.Columns.AutoFit

End Sub

如何使用VBA将筛选的单元格复制到新工作表

3 个答案: