Search workbooks containing same sheet name


Posted by Keith on July 05, 2000 8:11 AM

I think this one is tricky....

Can this be done and if so does someone know how to do it OR even part of it.

I need a Macro that will on one workbook ("DATA") copy a specified range, then look for the "same" sheet name and look in 3 other open workbooks for that sheet.

When found to paste special > values onto say row 10.

Then to go back to DATA and move onto the nextsheet and start over again.

EG;

DATA has say 4 work sheets (Alpha, Bravo, Charlie & Delta)

Other workbook #1 Contains Bravo
Other workbook #2 Contains Alpha
Other workbook #3 Contains Delta

So if on the Alpha sheet (on the DATA workbook) then it will paste onto Other Workbook #2 after searching Other workbooks #1 & 3.

If the sheet does not exist then to go back to DATA and go onto the next sheet and continue.

Does this make sense and will the Genius step forward.

Cheers (again),

Keith.

Posted by Keith on July 05, 0100 8:54 AM

Keith,

I did what you need but I would like to do it compeltly. If you can give a little more description on the ranges that are being copied and so on. If you want to email me or just post another message. Let me know!
Ryan

Posted by Keith on July 05, 0100 9:29 AM

Details

Ryan these are the details I hope you can use;

The 4 workbooks that will be open are:

Wb3_newd.xls
01EWS.xls
02EWS.xls
03EWS.xls

Wb3_newd.xls contains all the data that needs to be pasted onto the 3 other workbooks.

Wb3_newd.xls is in alphabetical order , same as the EWS files. The data from Wb3_newd.xls was split into the 3 EWS books.

The data to be copied from Wb3_newd.xls is row 29 .

The search looks for the sheet it took the data i.e. Alpha and looks for Alpha in 01/02/03EWS.xls when found pastes only the value in the last row of data in the sheet. The data starts from Row 19 and is ever growing, so it must find the last row of data and paste in the empty row below that.

Once finished it goes back to Wb3_newd.xls and goes to the next sheet (say Bravo), where it copies row 29 and then again looks for the sheet name (Bravo) in the other workbooks - if found again pastes the values in the next available empty row.

If sheet name does not exist in any EWS workbooks then it goes back to Wb3_newd.xls and continues on to the next sheet and again copies row 29.

When finished and when run out of sheets in Wb3_newd.xls it stops the Macro.

Hope this helps Ryan. If not reply and I'll e-mail you the stuff.


Keith.



Posted by Ryan on July 06, 0100 7:51 PM

Code

Keith,

Here you go. This does what I think you need done. It was working very well for me. Let me know how it turns out!
Ryan

Sub FindSheets()
Dim FindSheet As String
Dim Book As Workbook
Dim Sheet As Worksheet
Dim DataWorkbook As String
Dim FoundPage As Boolean
Dim OrigSheet As String

On Error GoTo ErrHandler
Application.ScreenUpdating = False

DataWorkbook = "Wb3_newd.xls"

Workbooks(DataWorkbook).Activate
OrigSheet = ActiveSheet.Name
For Each Sheet In Worksheets
Workbooks(DataWorkbook).Activate
FoundPage = False
FindSheet = Sheet.Name
Sheets(FindSheet).Select
Rows(29).Copy
For Each Book In Workbooks
If Book.Name = "Wb3_newd.xls" Or Book.Name = "PERSONAL.XLS" Then
Else

Book.Activate

If SheetExists(Sheet.Name) Then
Sheets(Sheet.Name).Select
LastRow = Range("A65536").End(xlUp).Row + 1
Rows(LastRow).Select
Sheets(Sheet.Name).Paste
Cells(LastRow, 1).Select
Application.CutCopyMode = False
FoundPage = True
End If
End If
If FoundPage = True Then Exit For
Next Book
Next Sheet

Application.CutCopyMode = False
Workbooks(DataWorkbook).Activate
Sheets(OrigSheet).Select
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
Workbooks(DataWorkbook).Activate
Sheets(OrigSheet).Select
Application.ScreenUpdating = True
MsgBox "There was an error", vbCritical, "Error"
End Sub

Function SheetExists(sname)
' Returns TRUE if sheet exists in the active workbook
Dim X As Object
On Error Resume Next
Set X = ActiveWorkbook.Sheets(sname)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function