CODEWITHSUNDEEP
vbaexcelexcel-2010
Deepak
Deepak

Reputation: 473

How to filter the table and paste the value in another sheet in Excel VBA

enter image description here

I would like to get value from the user and filter the table. I am filtering Column A (EP Number). Then copy the entire row to another sheet. If there is more than one row, copy both the rows and paste in different sheet.

I used the code below. Its not working and showing Type mismatch error.

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

Upvotes: 0

Views: 1596

Answers (1)

Shai Rado
Shai Rado

Reputation: 33692

First, since you are trying to check the AutoFilter Criteria with your variable str1, you need to take it outside the double-quote ", it need to be Criteria1:=str1.

Second, avoid all the unecessary Select and ActiveSheet, instead use fully qualifed objects.

You can use the Dim Tbl As ListObject , later set it explicitly by Set Tbl = Sheets("Sheet2").ListObjects("Table1").

Code

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

Upvotes: 2

Related Questions