updating multiple workbooks in VBA

[stonypaul]

I have several excel workbook files in a folder which have different names.
All of the files have just one worksheet.
The worksheet has a different name in each workbook, but other than that every worksheet is structured identically.
Therefore if I make a change to one workbook/worksheet, can I set up a 'master macro' which will open and update all of the workbooks with a single click, so I don't have to update each workbook individually?
Could someone advise some generic lines of code I can work with please?

Many thanks

 

[RSXchin]

do the workbook names change? If not, I've got a solution in mind.

 

[stonypaul]

yes the workbook names do change, but they are set in stone, so is it possible to select each workbook by name in the code?
Whether its means selecting each workbook individually with a line of code, or by selecting them all en masse using an array?

Thank you

 

[RSXchin]

This should work

Sub AllFolderFiles()
    Dim wb As Workbook
    Dim TheFile As String
    Dim MyPath As String
    MyPath = GetFolder
    ChDir MyPath
    TheFile = Dir("*.*")
    Do While TheFile <> ""
      Set wb = Workbooks.Open(MyPath & "\" & TheFile)
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
'PUT YOUR MACRO HERE
      wb.Close
      TheFile = Dir
    Loop
End Sub
Function GetFolder(Optional strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

 

[stonypaul]

I'm getting a runtime error 76 against the line ChDir MyPath ?

Below is the test code I have come up with

Thank you for your help so far

'
' Macro3 Macro
'
Sub AllFolderFiles()
    Dim wb As Workbook
    Dim TheFile As String
    Dim MyPath As String
    MyPath = GetFolder
    ChDir MyPath
    TheFile = Dir("*.*")
    Do While TheFile <> ""
      Set wb = Workbooks.Open(MyPath & "\" & TheFile)
   ActiveSheet.Unprotect
    Range("B6:V6").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B8:V8").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B8:V9").Select
    Selection.Copy
    Range("B8:V8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B10:V10").Select
    Range("B10:V10").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B7:V10").Select
    Selection.Copy
    Range("C16:V16").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B16:C16").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B18:V18").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B20:V20").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B16:V20").Select
    Selection.Copy
    Range("B26").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("B36").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("F22").Select
    ActiveWindow.SmallScroll Down:=-15
    Application.CutCopyMode = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Range("T15:V15").Select
    ActiveWindow.SmallScroll Down:=-12
      wb.Close
      TheFile = Dir
    Loop
End Sub
Function GetFolder(Optional strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

 

[RSXchin]

What folder are you spreadsheets in? What is the FULL PATH?

 

[stonypaul]

The full path is C:\Users\Documents\Timesheets

 

[RSXchin]

I think the problem is that you need to ChDrive

'
' Macro3 Macro
'
Sub AllFolderFiles()
    Dim wb As Workbook
    Dim TheFile As String
    Dim MyPath As String
    MyPath = GetFolder
    ChDrive Left(MyPath, Application.WorksheetFunction.Search(":", MyPath))
    ChDir MyPath
    TheFile = Dir("*.*")
    Do While TheFile <> ""
      Set wb = Workbooks.Open(MyPath & "\" & TheFile)
   ActiveSheet.Unprotect
    Range("B6:V6").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B8:V8").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B8:V9").Select
    Selection.Copy
    Range("B8:V8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B10:V10").Select
    Range("B10:V10").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B7:V10").Select
    Selection.Copy
    Range("C16:V16").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B16:C16").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B18:V18").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B20:V20").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B16:V20").Select
    Selection.Copy
    Range("B26").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("B36").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("F22").Select
    ActiveWindow.SmallScroll Down:=-15
    Application.CutCopyMode = False
    ActiveSheet.Protect DrawingObjects:=True, contents:=True, Scenarios:=True
    Range("T15:V15").Select
    ActiveWindow.SmallScroll Down:=-12
      wb.Close
      TheFile = Dir
    Loop
End Sub

Function GetFolder(Optional strPath As String) As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

 

[stonypaul]

Nothing seems to be happening.
I'm selecting the drive upon request but there is no runtime error or anything at all

 

[RSXchin]

you selected your folder? or just the drive?