如何在Excel VBA中筛选表格并将值粘贴到其他工作表中

我想从用户那里获取值并筛选表。我正在筛选A列（EP编号）。然后将整行复制到另一张图纸上。如果有多行，请复制这两行并粘贴到不同的工作表中

我使用了下面的代码。它不工作并且显示类型不匹配错误

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

---

首先，因为您试图用变量

str1

检查

AutoFilter

标准，所以需要将其置于双引号

“

之外，它必须是

Criteria1:=str1

第二步，避免所有不必要的

选择

和

活动表

，而是使用完全限定的对象

您可以将

Dim Tbl用作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          

---

首先，因为您试图用变量

str1

检查

AutoFilter

标准，所以需要将其置于双引号

“

之外，它必须是

Criteria1:=str1

第二步，避免所有不必要的

选择

和

活动表

，而是使用完全限定的对象

您可以将

Dim Tbl用作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          

---

第一次将

Criteria1:=“str1”

更改为

Criteria1:=str1

。从

str1

中删除双引号。首先将

Criteria1:=“str1”

更改为

Criteria1:=str1

。从str1中删除双引号。谢谢您的代码。过滤单独起作用，但复制并粘贴到不同的纸张不起作用。我试过了。并且总是在Msgbox中获取消息。如何解决这个问题。帮助me@Deepak现在尝试编辑的代码，我删除了一个不需要的部分，并调整了

的参数，如果FiltRng.Rows.Count>=1，那么

。现在应该可以用了，再次谢谢。现在，过滤、复制和粘贴都可以工作了。但当我输入的值错误时，它不会在msgbox中显示消息。我得到了这个错误“未设置块的对象或变量”，并且by table不可见。如何解决这个问题。帮帮我，再次谢谢。代码起作用。但是我需要添加clearcontents和clearfilter。在哪里添加。因为当我第二次计算时，有时旧数据仍然存在。@Deepak这听起来像是一篇很棒的新帖子，所以在此期间，请接受我的回答，因为我已经回答了当前帖子的所有方面谢谢你的代码。过滤单独起作用，但复制并粘贴到不同的纸张不起作用。我试过了。并且总是在Msgbox中获取消息。如何解决这个问题。帮助me@Deepak现在尝试编辑的代码，我删除了一个不需要的部分，并调整了

的参数，如果FiltRng.Rows.Count>=1，那么

。现在应该可以用了，再次谢谢。现在，过滤、复制和粘贴都可以工作了。但当我输入的值错误时，它不会在msgbox中显示消息。我得到了这个错误“未设置块的对象或变量”，并且by table不可见。如何解决这个问题。帮帮我，再次谢谢。代码起作用。但是我需要添加clearcontents和clearfilter。在哪里添加。因为当我第二次计算时，有时旧数据仍然存在。@Deepak这听起来像是一篇很棒的新帖子，所以在此期间，请接受我的回答，因为我已经回答了当前帖子的所有方面