Excel Macro to perform against list of files.

[mrtroy]

I am trying to create a macro that copies data from all the files in a directory to a file called costs.xls. But my macro keeps trying to open the same file. Your help is appreciated. Listed below is what I have.

Sub DirLoop()

Dim MyFile As String, Sep As String

' Sets up the variable "MyFile" to be each file in the directory
' This example looks for all the files that have an .xls extension.
' This can be changed to whatever extension is needed. Also, this
' macro searches the current directory. This can be changed to any
' directory.

' Test for Windows or Macintosh platform. Make the directory request.
Sep = Application.PathSeparator

If Sep = "\" Then
' Windows platform search syntax.
MyFile = Dir(CurDir() & Sep & "*.xls")

Else

' Macintosh platform search syntax.
MyFile = Dir("", MacID("XLS5"))
End If

' Starts the loop, which will continue until there are no more files
' found.

Do While MyFile <> ""

' Displays a message box with the name of the file. This can be
' changed to any procedure that would be needed to run on every
' file in the directory such as opening each file.

'MsgBox CurDir() & Sep & MyFile
'MyFile = Dir()

Workbooks.Open FileName:=MyFile
Sheets("03-SG&A").Select


Range("C2").Select
Selection.Copy
Range("A9:A163").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("A:A").EntireColumn.AutoFit
Cells.Select
Application.CutCopyMode = False

'Filter Budget Lines
Selection.AutoFilter
Range("B5").Select
Selection.AutoFilter Field:=2, Criteria1:=">=50000", Operator:=xlAnd, _
Criteria2:="<80000"
Range("A9:O104").Select
Selection.Copy

Windows("costs.xls").Activate

Range("a1").Activate
Do While ActiveCell <> ""
ActiveCell.Offset(1, 0).Activate
Loop
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False

Windows(MyFile).Activate
ActiveWorkbook.Close (False)






Loop

End Sub

 

[foundryqa]

mrtroy

After a quick glance at your code, I'm not sure how the do..loop indexes through the files in the directory?

I did find a bit of code on another site that seems to be just what you are looking for. Make sure that you reference the "Microsoft Scripting Runtime" library under references so that vba will know how to handle the "filesystemobject". This code has the advantages of the for each structure.

http://www.visualbasicforum.com/t81115.html

Please let me know if you have any problems with it.

Fred

 

[GlennUK]

Hi mrtroy,

quoting from your code:

Do While MyFile <> ""

' Displays a message box with the name of the file. This can be
' changed to any procedure that would be needed to run on every
' file in the directory such as opening each file.

'MsgBox CurDir() & Sep & MyFile
'MyFile = Dir()

THIS CALL TO DIR IS COMMENTED OUT!
Try it without the '
By the way the last call to Dir will return "", but you haven't coded for MyFile being "" after the call.

Cheers, Glenn.

 

[ajakeway]

I was looking for some things related to this and noted the following link:

http://j-walk.com/ss/excel/tips/tip82.htm

which might be of some help. Alternatively...

http://j-walk.com/ss/excel/tips/tip18.htm

will get a list of file names in a directory. You should be able to easily modify the code to get what you want.

Enjoy!