ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Replacing One Sheet in Several Files (https://www.excelbanter.com/excel-programming/288262-replacing-one-sheet-several-files.html)

Mark[_22_]

Replacing One Sheet in Several Files
 
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

Ron de Bruin

Replacing One Sheet in Several Files
 
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



--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"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




Ron de Bruin

Replacing One Sheet in Several Files
 
Application.DisplayAlerts = False
Wb.Sheets("MKR15").Delete
Application.DisplayAlerts = False


must be

Application.DisplayAlerts = False
Wb.Sheets("MKR15").Delete
Application.DisplayAlerts = True



--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"Ron de Bruin" wrote in message ...
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



--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2000-2003)
www.rondebruin.nl



"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






Nick Hodge

Replacing One Sheet in Several Files
 
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 Befo=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
HIS



Mark wrote:
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




Rob van Gelder[_4_]

Replacing One Sheet in Several Files
 
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




Rob van Gelder[_4_]

Replacing One Sheet in Several Files
 
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


"Rob van Gelder" wrote in message
...
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







All times are GMT +1. The time now is 05:41 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com