Ryan you may be able to help.

Ryan,

I wonder if it is possible to have another workbook open that is not to be included in the macro.

The workbook is called EWS01.xls

I've tried doing a Dim thing and stating the workbookname to carry on with out but my capabilities are limited.

Hope you or anyone else can help.

Keith.

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 = "EWS MASTER.xls"

Workbooks(DataWorkbook).Activate
OrigSheet = ActiveSheet.Name
For Each Sheet In Worksheets
Workbooks(DataWorkbook).Activate
FoundPage = False
FindSheet = Sheet.Name
Sheets(FindSheet).Select
Rows(30).Copy
For Each Book In Workbooks
If Book.Name = "EWS MASTER.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
Rows("29:29").Select
Selection.Insert Shift:=xlDown
Rows("30:30").Select
Selection.Copy Destination:=Rows("29:29")
Rows("31:31").Select
Selection.Cut
Rows("30:30").Select
ActiveSheet.Paste

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