Might of been someone on this forum came up with this macro for me (GREATLY APPRECIATED) many years ago. I rarely use excel stuff other than for simple things. So I don't know the first thing about Macro code. We get updated price pages from our supplier each season and then we have to update two fields in each spreadsheet, several hundred pages scattered across several directories. This code works great, but I have to modify the directory each time. Is there a way to modify this code to not only process the directory, but all the subdirectories?
THANKS
Sub UpdatePricing()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim sourceRange2 As Range
Dim destrange2 As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
SaveDriveDir = CurDir
MyPath = "C:\Fence Pricing\Components\Retail"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
'Set sourceRange = basebook.Worksheets("Sheet1").Range("a1:c5")
'Set destrange = mybook.Worksheets(1).Range("a1")
'sourceRange.Copy destrange
' Instead of this lines you can use the code below to copy only the values
'Sets Multiplier'
Set sourceRange = basebook.Worksheets(1).Range("a1:a1")
Set destrange = mybook.Worksheets(1).Range("l1:l1")
destrange.Value = sourceRange.Value
'Sets Markup'
Set sourceRange2 = basebook.Worksheets(1).Range("a2:a2")
Set destrange2 = mybook.Worksheets(1).Range("l2:l2")
destrange2.Value = sourceRange2.Value
mybook.Close True
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
Bookmarks