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

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

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

你可以尝试这样的事情（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 2

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

 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 3

我build议下面的代码基于以下假设（符合提供的代码）：

1. 源数据的工作表处于活动状态
2. 数据源已被过滤，否则在所提供的代码中应用的filter将无法在所有情况下工作。

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

3. 数据源从单元格A1开始（按照第一个filter： Range("D1").AutoFilter Field:=4 ）
4. 数据源至less到第33列（按照第三个filter： 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