Filter and copy data

Hi,

Here's a beginning:

Sub Whar()
Dim w1 As Worksheet, w2 As Worksheet, ToGet As String
GetProduct:            ToGet = InputBox("What Product?")
                        If ToGet = "" Then Exit Sub
        Set w1 = Sheets("Sheet1"): Set w2 = Sheets("Sheet2")
        ws.Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=ToGet
        
        w1.UsedRange.SpecialCells(xlCellTypeVisible).Copy
        w2.Range("B1").PasteSpecial Transpose:=True
End Sub

Hi,

Try this:Thar.xlsm

Hi xladept

This is exactly what I want to do. However, In my original document, in Sheet 1 there are some other information in other columns D E F etc).
Does this affect when copying the filtered data? t doesnt work as good when I have values in columns other than A.

Thankyou for your help


PS: the problem is If I put "Pants - Nike" or the product after some leters, it doesnt get filtered. How do I fix this?

Hi Thar,

This seems to work:

Sub Filter()
Dim w1 As Worksheet, w2 As Worksheet, ToGet As String, r As Long
Set w1 = Sheets("MAINT"): Set w2 = Sheets("MAINT_LINKING")
GetProduct:  For r = 2 To w2.Range("A" & Rows.Count).End(xlUp).Row
                    ToGet = Range("A" & r) & "*"
                        If ToGet = "" Then Exit Sub
        
        w1.Range("A2").CurrentRegion.AutoFilter Field:=1, Criteria1:=ToGet
        
        w1.UsedRange.Offset(1).Resize(, 1).SpecialCells(xlCellTypeVisible).Copy
        w2.Range("B" & r).PasteSpecial Transpose:=True
        Next r
        w1.AutoFilterMode = False
        Application.CutCopyMode = False
End Sub

Hi Thar,

Thanks for the rep!

One more wildcard - try it now

Sub Filter()
Dim w1 As Worksheet, w2 As Worksheet, ToGet As String, r As Long
Set w1 = Sheets("MAINT"): Set w2 = Sheets("MAINT_LINKING")
GetProduct:  For r = 2 To w2.Range("A" & Rows.Count).End(xlUp).Row
                    ToGet = "*" & Range("A" & r) & "*"
                        If ToGet = "" Then Exit Sub
        
        w1.Range("A2").CurrentRegion.AutoFilter Field:=1, Criteria1:=ToGet
        
        w1.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).Copy
        w2.Range("B" & r).PasteSpecial Transpose:=True
        Next r
        w1.AutoFilterMode = False
        Application.CutCopyMode = False
End Sub

You're welcome!