如何篩選表格並將值粘貼到Excel VBA中的另一個工作表中

Question

我想從用戶那里獲取價值並篩選表格。 我正在過濾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

Answer 1

首先 ，由於您嘗試使用變量str1檢查自動AutoFilter條件，因此需要將其置於雙引號" ，它必須為Criteria1:=str1 。

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

您可以使用Dim Tbl As ListObject ，稍后通過Set Tbl = Sheets("Sheet2").ListObjects("Table1")對其進行顯式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