使用 VBA 在 Excel 中设置过滤器

Question

下面的宏将允许我在表 1 的标题中找到一个名称，并将整个列复制到表 2。现在我想继续代码，但遇到了一个问题，我将尝试解释。

Sub CopyColumnByTitle()
'Find "Name" in Row 1
  With Sheets(1).Rows(1)
   Set t = .Find("Name", lookat:=xlpart)
'If found, copy the column to Sheet 2, Column A
'If not found, present a message
     If Not t Is Nothing Then
        Columns(t.Column).EntireColumn.Copy _
          Destination:=Sheets(2).Range("A1")
       Else: MsgBox "Title Not Found"
     End If
  End With
End Sub

将所有数据粘贴到工作表 2 中后，如下所示......

Sheet 2
Name Age Address    Date of Birth
John    25  US  1-Sep-11
Hary    26  US  1-Sep-11
John    27  UK  1-Sep-11
Hary    28  US  2-Sep-11
King    29  UK  3-Sep-11
Peter   30  US  3-Sep-11

我需要设置过滤器，如下所示，并将过滤后的数据复制到表 3，就像上面的代码一样：

1. 我需要在工作表 2 上设置过滤条件，这有助于我查看等于“John”或“Hary”的 Names，并将整个数据复制并粘贴到工作表 3 中。
2. 我需要设置另一个过滤器，其中Name 等于“John”，Date of Birth 等于“1-Sep-11”（注意日期应始终为昨天）。复制并粘贴整个 数据到工作表 4。
3. 第三次，我需要设置一个过滤器，其中Name 等于“King”，并将整个数据复制并粘贴到工作表 5 中。

更新

非常感谢John您的回复，您的回复是有效的，但我已经设计了我的代码。

我正在粘贴部分代码，因为无法粘贴整个代码。

代码允许我将数据从一个工作簿复制到另一个工作簿，但是在复制数据时，我需要复制整个列，因为其中有一些空白单元格。所以如果我不使用.EntireColumn，宏不会复制空白单元格之后的单元格。同样现在，在将数据粘贴到其他工作簿时，我需要将其粘贴不带标题。

Windows("macro2.xlsm").Activate
Range(Range("M2"), Range("N2").End(xlDown)).EntireColumn.Select
Application.CutCopyMode = False
Selection.Copy
Windows("formula.xls").Activate
Range(Range("I2"), Range("J2").End(xlDown)).EntireColumn.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Answer 1

任务 1：

 thisworkbook.sheets(2).activate
 activesheet.range("A:A").select 'set column you filter for probable names here
 Selection.AutoFilter Field:=1, Criteria1:="=John", Operator:=xlOr, _
 Criteria2:="=Hary" ' filters  only for hary or john 
 activate.usedrange.select ' now select the filtered sheet to copy  
 selection.copy 
 ActiveSheet.ShowAllData ' now retain back the data so that you get your original file
 thisworkbook.sheets(3).activate  'select your sheet3 and paste it
 activate.range("A1").select
 activesheet.paste

任务 2：

 thisworkbook.sheets(2).activate
 activesheet.range("A:A").select \\'set column you filter for probable names here
 Selection.AutoFilter Field:=1, Criteria1:="John" \\ filters for john
 Selection.AutoFilter Field:=2, Criteria1:="1-sep-2011"  \\ filters for date only for john rows 
 activate.usedrange.select ' now select the filtered sheet to copy  
 selection.copy 
 ActiveSheet.ShowAllData ' now retain back the data so that you get your original file
 thisworkbook.sheets(4).activate  'select your sheet3 and paste it
 activate.range("A1").select
 activesheet.paste

任务 3

 thisworkbook.sheets(2).activate
 activesheet.range("A:A").select 'set column you filter for probable names here
 Selection.AutoFilter Field:=1, Criteria1:="=King" ' filters  only king 
 activate.usedrange.select ' now select the filtered sheet to copy  
 selection.copy 
 ActiveSheet.ShowAllData ' now retain back the data so that you get your original file
 thisworkbook.sheets(5).activate  'select your sheet3 and paste it
 activate.range("A1").select
 activesheet.paste

可能它会给你一些想法如何做到这一点。如有更多疑问，请随时问我。

谢谢！你可能会去复制目的地：= 和更多的方式来做到这一点。实际上我现在得走了，所以我只是给了你一个样片来处理。