Mark,

Sub testit()
Const cFileList = "C:\T\filelist.xls"
Const cMKR15 = "C:\T\source.xls"
Const cMKR15_WksName = "MKR15", cUnique = "$$$"
Const cFileMax = 40

Dim wkb As Workbook, wkbDest As Workbook, wks As Worksheet
Dim arrFiles(cFileMax - 1) As String, i As Long, blnTemp As Boolean

On Error Resume Next
Set wkb = Workbooks(FileNameFromPath(cFileList))
If Err Then
Set wkb = Workbooks.Open(cFileList)
Err.Clear
End If
With wkb.Worksheets(1).Cells(1, 1)
For i = 0 To cFileMax - 1
arrFiles(i) = .Offset(i, 0).Value
Next
End With
wkb.Close False

Set wkb = Workbooks(FileNameFromPath(cMKR15))
If Err Then
Set wkb = Workbooks.Open(cMKR15)
Err.Clear
End If

Application.ScreenUpdating = False
For i = 0 To cFileMax - 1
Set wkbDest = Workbooks(FileNameFromPath(arrFiles(i)))
If Err Then
Err.Clear
Set wkbDest = Workbooks.Open(arrFiles(i))
If Err Then Set wkbDest = Workbooks.Add
Err.Clear
End If
Set wks = wkbDest.Worksheets(cMKR15_WksName)
If Err Then
Set wks = wkbDest.Worksheets(1)
Err.Clear
End If
wks.Name = wks.Name & cUnique
wkb.Worksheets(cMKR15_WksName).Copy Befo=wks
blnTemp = Application.DisplayAlerts
Application.DisplayAlerts = False
wks.Delete
wkbDest.SaveAs arrFiles(i)
Application.DisplayAlerts = blnTemp
wkbDest.Close False
Next
Application.ScreenUpdating = True

Exit Sub
e: MsgBox "Error with " & arrFiles(i) & vbNewLine & Err.Description,
vbCritical, "Error"
End Sub

Function FileNameFromPath(Path As String) As String
Dim i As Long
For i = Len(Path) To 1 Step -1
If Mid(Path, i, 1) = Application.PathSeparator Then Exit For
Next
FileNameFromPath = Mid(Path, i + 1)
End Function


Rob

"Mark" wrote in message
om...
Need to replace one sheet named "MKR15" in 40 different files.
The file containing the new copy of "MKR15" is "c:\work\source.xls".

A list of the file names (including paths) is in "filelist.xls" in cells
a1:a40.

I'd like to write VB code to perform this operation.

Any suggestions?

Thanks, Mark