如何在Excel VBA中过滤表格并将其粘贴到另一个表格中

我想从用户中获得价值并过滤表格。 我正在过滤列A（EP编号）。 然后将整行复制到另一个工作表。 如果有多行，则复制两行并粘贴到不同的工作表中。

我使用下面的代码。 它不工作，并显示types不匹配错误。

Private Sub CommandButton1_Click() Dim str1 As String str1 = Application.InputBox("Enter EP Number") If CStr(str1) Then Sheets("Sheet2").Select ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= _ "str1", Operator:=xlAnd Range("A10:E10").Select Selection.Copy Sheets("Sheet4").Select Range("Table2").Select ActiveSheet.Paste Range("J7").Select Else MsgBox ("Wrong EP") End If End Sub 

Answer 1

首先 ，由于您正在尝试使用variablesstr1来检查AutoFilter Criteria，因此您需要将其放在双引号"之外" ，它需要是Criteria1:=str1 。

其次 ，避免所有不必要的Select和ActiveSheet ，而是使用完全限定的对象。

您可以使用Dim Tbl As ListObject ，稍后通过Set Tbl = Sheets("Sheet2").ListObjects("Table1")显式设置它。

码

 Option Explicit Private Sub CommandButton1_Click() Dim str1 As String Dim Tbl As ListObject Dim FiltRng As Range Dim RngArea As Range ' set the List Object "Table1" Set Tbl = Sheets("Sheet2").ListObjects("Table1") str1 = Application.InputBox("Enter EP Number") Tbl.Range.AutoFilter field:=1, Criteria1:=str1 ' when using Filtered range, the range can be splitted to several areas >> loop through each one of them For Each RngArea In Tbl.Range.SpecialCells(xlCellTypeVisible).Rows ' don't use the Header Row If RngArea.Row > 1 Then If Not FiltRng Is Nothing Then Set FiltRng = Application.Union(FiltRng, RngArea) Else Set FiltRng = RngArea End If End If Next RngArea If Not FiltRng Is Nothing Then ' filter range is not empty FiltRng.Copy Else MsgBox "No Records match in the Table", vbCritical Exit Sub End If ' do here your paste thing End Sub