[HELP] How to marco to cut Entire row to new sheet if cell data matched

[harky]

I got this code from one of the thread here.. need pro here to guide me along

this code cut Entire row to new sheet but this code is gd if i dont have much data to cut and paste.
but What i want is,

is it possible Match P/N in Excel 2 with Masterdata (excel 1) P/N column and cut the entire row in Masterdata (excel 1) to another new excel?

Masterdata (excel 1)

P/N	DESP	Price	Discount Price
001	APPLE	10.00	9.00
002	APPLE	10.00	9.00
003	APPLE	9.00	8.00
004	BANANA	8.00	7.00
005	CHERRY	10.00	9.50
006	CHERRY	8.00	7.50
007	DURIAN	5.00	4.00
008	ORANGE	4.00	3.00
009	ORANGE	8.00	2.00

<tbody>
</tbody>

Match P/N (excel 2)

P/N
001
002
003
004
005
006
007
008
009

<tbody>
</tbody>

Sub test()  Dim WSD As Worksheet  Application.ScreenUpdating = False  Set WSD = Worksheets("Sheet2")  WSD.Cells.Clear With ActiveSheet.UsedRange     LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column     Cells(2, LastColumn + 2).FormulaR1C1 = "=MATCH(RC2,{""Apple"",""Cherry"",""Orange""},0)"     .AdvancedFilter Action:=xlFilterInPlace, criteriarange:=Cells(1, LastColumn + 2).Resize(2, 1)     .Copy Destination:=WSD.Cells(1, 1)     On Error Resume Next     .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible).EntireRow.Delete     If Err.Number <> 0 Then         MsgBox "No records found..."         WSD.Rows(1).Delete         On Error GoTo 0     End If End With  ActiveSheet.ShowAllData Columns(LastColumn + 2).Clear  Application.ScreenUpdating = True  End Sub</pre>

 

[harky]

here the code

Sub DSDSD()

Dim WSD As Worksheet

Application.ScreenUpdating = False

Set WSD = Worksheets("Sheet2")

WSD.Cells.Clear
With ActiveSheet.UsedRange
    LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
    Cells(2, LastColumn + 2).FormulaR1C1 = "=MATCH(RC2,{""Apple"",""Cherry"",""Orange""},0)"
    .AdvancedFilter Action:=xlFilterInPlace, criteriarange:=Cells(1, LastColumn + 2).Resize(2, 1)
    .Copy Destination:=WSD.Cells(1, 1)
    On Error Resume Next
    .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    If Err.Number <> 0 Then
        MsgBox "No records found..."
        WSD.Rows(1).Delete
        On Error GoTo 0
    End If
End With

ActiveSheet.ShowAllData
Columns(LastColumn + 2).Clear

Application.ScreenUpdating = True

End Sub

 

[harky]

anyway can help :D