Do same thing to each workbook found in a folder

[KENNY]

Hi,

I'd like to open each workbook in a folder, make a certain
change, save the file, close it, and go to the next...

Help?!

 

[Bob Phillips]

Sub ProcessFiles()Dim sFolder As String
Dim FSO As Object
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Dim oWb As Workbook

Set FSO = CreateObject("Scripting.FileSystemObject")

sFolder = "C:\myTest"
If sFolder <> "" Then
Set Folder = FSO.GetFolder(sFolder)
Set Files = Folder.Files
For Each file In Files
If file.Type = "Microsoft Excel Worksheet" Then
Set oWb = Workbooks.Open FileName:=file.Path
KennysMacro
End If
Next file

End If ' sFolder <> ""

End Sub

 

[KENNY]

Thanks for the response: I've tried to shoehorn your code
to my sample macro, but have two problems (the rows with
***). Could you have a look? Thanks!


Sub CULL()
' CULL Macro
' Macro recorded 10/7/2004 by dykoffp

Dim FSO As Object
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Dim oWb As Workbook

Set FSO = CreateObject("Scripting.FileSystemObject")

sFolder = "Y:\Sales\2005 Sales Forecast Workbooks\2005
Sales Forecast - Working Files"
If sFolder <> "" Then
Set Folder = FSO.GetFolder(sFolder)
Set Files = Folder.Files
For Each file In Files
If file.Type = "Microsoft Excel Worksheet" Then
*** Set oWb = Workbooks.Open FileName:=file.Path


Range("H7").Select
Selection.Copy
Range("I7").Select
Selection.PasteSpecial Paste:=xlFormulas,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("H15").Select
ActiveWorkbook.Save
ActiveWorkbook.Close

End If
Next file

*** End If sFolder <> ""

 

[Bob Phillips]

My fault for trying to adjust some other code.

Try this (watch the wrap-around)

Sub CULL()
' CULL Macro
' Macro recorded 10/7/2004 by dykoffp

Dim FSO As Object
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Dim oWb As Workbook
Dim sFolder As String

Set FSO = CreateObject("Scripting.FileSystemObject")

sFolder = "Y:\Sales\2005 Sales Forecast Workbooks\2005 Sales Forecast -
Working Files"
If sFolder <> "" Then
Set Folder = FSO.GetFolder(sFolder)
Set Files = Folder.Files
For Each file In Files
If file.Type = "Microsoft Excel Worksheet" Then
Set oWb = Workbooks.Open(Filename:=file.Path)
Range("H7").Select
Selection.Copy
Range("I7").Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("H15").Select
ActiveWorkbook.Save
ActiveWorkbook.Close

End If
Next file

End If
End Sub

 

[KENNY]

Success! Thank you VERY much

-----Original Message-----
My fault for trying to adjust some other code.

Try this (watch the wrap-around)

Sub CULL()
' CULL Macro
' Macro recorded 10/7/2004 by dykoffp

Dim FSO As Object
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Dim oWb As Workbook
Dim sFolder As String

Set FSO = CreateObject("Scripting.FileSystemObject")

sFolder = "Y:\Sales\2005 Sales Forecast

Workbooks\2005 Sales Forecast -