
Originally Posted by
xld
John,
Time to stop providing solutions with FileSearch. In Excel 2007, FileSearch is gone, so for forward compatibility ...
Really? Oh well, this is shorter anyway.
Scrap the previous Simon and use this instead (same instructions)
Option Explicit
Sub ReplaceThisWorkbookProcedures()
Dim FileFound As Object
Dim NewCode As String
' ThisWorkbook is the file containing all the new ThisWorkbook procedures
With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
NewCode = .Lines(1, .countoflines) '< "copy" the code
End With
' open all files you want the new procs in
With Application
.ScreenUpdating = False
.DisplayAlerts = False
For Each FileFound In CreateObject("Scripting.FileSystemObject") _
.GetFolder(ThisWorkbook.Path).Files
If Right(FileFound.Name, 4) = ".xls" _
And Not FileFound.Name = ThisWorkbook.Name Then
Workbooks.Open(FileFound).Activate
' Delete old procedures and replace with new
With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
.DeleteLines 1, .countoflines
.InsertLines 1, NewCode '< "paste" the code
End With
ActiveWorkbook.Close savechanges:=True
End If
Next
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub