Replacing One Sheet in Several Files

  • Thread starter Thread starter Mark
  • Start date Start date
M

Mark

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
 
Try this Mark
copy the macro in "c:\work\source.xls"
file path/names in Sheets("Sheet1").Range("A1:A40")


Sub test()
Dim Wb As Workbook
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A1:A40")
On Error Resume Next
Set Wb = Workbooks.Open(cell.Value)
Application.DisplayAlerts = False
Wb.Sheets("MKR15").Delete
Application.DisplayAlerts = False
ThisWorkbook.Sheets("MKR15").Copy after:=Wb.Sheets(Sheets.Count)
Wb.Close True
Next
Application.ScreenUpdating = True
End Sub
 
Mark

Put this code in filelist.xls (Assumes file names are on Sheet1 in this
book). It will take the MKR15 sheet, delete it in the file and replace the
one from source.xls in the same sheet position

Sub ChangeMKR15()
Dim shtNew As Worksheet
Dim sourceWB As Workbook
Dim currWB As Workbook
Dim rRange As Range
Dim myCell As Range
Dim iIndex As Integer

On Error Resume Next

With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

Set rRange = Worksheets("Sheet1").Range("A1:A40")
Set sourceWB = Workbooks.Open("C:\Work\Source.xls")
Set shtNew = sourceWB.Worksheets("MKR15")
For Each myCell In rRange
Set currWB = Workbooks.Open(myCell.Value)
iIndex = currWB.Worksheets("MKR15").Index
currWB.Worksheets("MKR15").Delete
If iIndex > currWB.Worksheets.Count Then
shtNew.Copy after:=currWB.Worksheets(iIndex - 1)
Else
shtNew.Copy Before:=currWB.Worksheets(iIndex)
End If
currWB.Close SaveChanges:=True
Set currWB = Nothing
Next myCell

sourceWB.Close (False)
Set rRange = Nothing
Set sourceWB = Nothing
Set shtNew = Nothing
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub


--
HTH
Nick Hodge
Microsoft MVP - Excel
Southampton, England
(e-mail address removed)
 
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 Before:=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
 
I meant to explain why I've done certain things here before I posted.

I've tried to assume that sometimes you already have these files open -
which is why there are If Err statements everywhere.
I also assume that MKR15 is the only worksheet in those 40 workbooks.
Since you can't delete the last sheet, it renames it first, copied the new
sheet, then deleted the old.
Also creates the file1 -> 40 if it doesn't yet exist.

Cheers,
Rob
 
Back
Top