Copy rows if specific text in coloum A

I found this macro in google.. please edit this for my needs,,

I have some specific procucts in coloum A in sheet (data), If that product was found in Sheets("allproducts"), copy all the rows and create a new sheet on the product name and save the excel.


Please help me in this..



Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 1
LSearchRow = 1

'Start copying data to row 2 in Sheet2 (row counter variable)
LCopyToRow = 2

While Len(Range("H" & CStr(LSearchRow)).Value) > 0

'If value in column H = "product1", copy entire row to Sheet2
If Range("H" & CStr(LSearchRow)).Value = "product1" Then

'Select row in allproducts to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into Sheet2 in next row
Sheets("Sheet2").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to allproducts to continue searching
Sheets("allproducts").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on cell A2
Application.CutCopyMode = False
Range("A2").Select






MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub