Macro for collecting rows from sheets if cell mach value

[intrabalticum]

I need help to make script in Excel2007to collect (copy) rows from all sheets to one sheet with name "One " if cell F in all sheets, except sheet "One" have value "One". I got one from old boards but it is good for Excel2003 and gives back error in Excel2007. What is wrong in it?

Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 4
LSearchRow = 4

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

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

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

'Select row in Sheet1 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 Sheet1 to continue searching
Sheets("Sheet1").Select

End If

LSearchRow = LSearchRow + 1

Wend

'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

This collects data only from one sheet with mach and paste to another. What must be changed to do what I need? I am making just first steps.

Thanks in advance.

 

[Saagar]

You have two requirements:
- it is good for Excel2003 and gives back error in Excel2007. What is wrong in it?
I haven't used Excel2007. If you send the error message, we may be able to help.

- This collects data only from one sheet with mach and paste to another. What must be changed to do what I need?
- Here is the code that should work on multiple sheets. This will not search in "sheet2". It will only paste data meeting search criteria to sheet2. I did not test the code. So test it and let me know if you have issues.

Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

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

for j = 1 to activeworkbook.sheets.count
sheetname = Sheets(j).name

if sheetname <> "Sheet2" then

Sheets(j).select

'Start search in row 4
LSearchRow = 4

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

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

'Select row in Sheet1 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 current source sheet to continue searching
Sheets(j).Select

End If

LSearchRow = LSearchRow + 1

Wend

endif

loop
'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

 

[intrabalticum]

Thanks for Your example. There goes some error with loop or somewhere must be next j in script. I can't find where.

 

[Saagar]

You are correct. I used the wrong syntax. In the code, replace the word "Loop" with "Next j".

 

[intrabalticum]

Script gives back an error and I don't know what kind of error
Is it possible to send my excel file to see what a problem is?

 

[Saagar]

I will PM you my email address.

 

[winrz]

Did you guys figure out the error? I too am using 2007 and cant figure out the error in the command to paste the row that was copied.

 

[Saagar]

Yes. We got the code working.

The error returned was the error handling message that was included in the code above.

.
.
.
.
Exit Sub

[B][COLOR=Red]Err_Execute:
MsgBox "An error occurred."[/COLOR][/B]

End Sub         
[code]

There were other things that needed to be fixed for the code to work.

Start a new thread, post your code with the error message you are getting and I will help you out. After posting the details send me a PM with the link to your thread.