VBA Search workbook for user value, copy/paste entire row to last sheet for matching

Hi all,

I am trying to search my entire workbook, in column C starting with row 2 on each page, for a user defined value. I'd like it to then copy the entire row and paste it to the last sheet ("Sheet4") for all matching values starting at row 2. I seem to be hitting a snag after changing my code from just doing "Sheet1" to the entire workbook. Please help trouble shoot.


My code is below
Thanks in advanced!




Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim LSearchValue As String

On Error GoTo Err_Execute

LSearchValue = InputBox("Please enter a value to search for.", "Enter value")

'Start search in row 2
LSearchRow = 2

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

For j = 1 To ActiveWorkbook.Sheets.Count
With Sheets(j)
i = 1
Do While .Range("C1").Cells(i) <> ""

'If value in column E = LSearchValue, copy entire row to Sheet2
If UCase(LSearchValue) = UCase(.Range("C1").Cells(i)) Then

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

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

'Move counter to next row
LCopyToRow = LCopyToRow + 1


End If
i = i + 1
LSearchRow = LSearchRow + 1

Loop
End With
Next
'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code. Posting code without them makes your code hard to read and difficult to be copied for testing. Highlight your code and click the # at the top of your post window. For more information about these and other tags, found here