Code modification
Posted by Keith on July 19, 2000 8:28 AM
I'm wondering if the code listed can be altered slightly.
The code is great.
From the Workbook that contains the data (EWS MASTER.xls) it looks for sheets that have the same name. Once found it inserts a line of data.
The tables have turned and I need to change the code so that I have a random named workbook that contains data that needs to be inserted over the top of the old (i.e. EWS MASTER).
Problem is the EWS MASTER is named so that has to be taken out but I don't and will not know the name of the workbook to take its place.
Hope this is clear.
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 = True
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
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
Posted by Ryan on July 19, 0100 8:37 AM
Keith,
Try this one. The only thing is that the DataWorkbook, whatever it will be, must be the active workbook when starting this macro. Everything else should work the same!
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 = True
DataWorkbook = ThisWorkbook.Name
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 = DataWorkbook 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
