View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.misc
JLatham JLatham is offline
external usenet poster
 
Posts: 3,365
Default Move Workbooks With Certain Name?

Put this code into a workbook's regular code area, save the workbook in the
same folder with the files to be moved, then run the macro. It will not only
do the moves but will report the names of the files moved in a worksheet
(current active one when you start the macro) and will give you a message
telling you how many files were moved when the process finishes.

Easy way to get the code where it needs to go: press [Alt]+[F11] to open the
VB Editor. Choose Insert | Module from the VBE editor and cut and paste the
code into that module. Close the VB Editor and have at it (after saving the
workbook to the proper folder) - the file must be saved to that initial
folder for it all to work.

Sub MoveExceptions()
Const keyWord = "Exceptions"
Dim basePath As String
Dim newPath As String
Dim anyFile As String
Dim oldLoc As String
Dim newLoc As String
Dim rOffset As Long
Dim baseCell As Range
Dim filesMovedCount As Long

Set baseCell = ActiveSheet.Range("A" & Rows.Count). _
End(xlUp).Offset(1, 0)
basePath = ThisWorkbook.FullName
basePath = Left(basePath, InStrRev(basePath, "\"))
newPath = basePath & "Exceptions\"
On Error Resume Next
anyFile = Dir(newPath & "*.*", vbHidden + vbSystem)
If Err < 0 Or anyFile = "" Then
'must create the new path
Err.Clear
MkDir newPath
End If
On Error GoTo 0
anyFile = Dir$(basePath & "*.xls")
Do While anyFile < ""
If anyFile < ThisWorkbook.Name Then
'UCase makes the spelling case-insensitive
If InStr(UCase(anyFile), UCase(keyWord)) Then
newLoc = newPath & anyFile
oldLoc = basePath & anyFile
On Error Resume Next
Name oldLoc As newLoc
If Err < 0 Then
Err.Clear
baseCell.Offset(rOffset, 0) = _
anyFile & " Not Moved: Destination File Exists Already"
Else
baseCell.Offset(rOffset, 0) = anyFile
filesMovedCount = filesMovedCount + 1
End If
rOffset = rOffset + 1
On Error GoTo 0
End If
End If
anyFile = Dir$()
Loop
MsgBox filesMovedCount & " " & keyWord & " files moved."
End Sub


"Dave" wrote:

Hi Everyone,

I'm looking for help with a macro to move some Worksheets from one folder to
another (i.e. cut & paste).

The destination folder will need to also be created by the Macro.

In english, the macro will need to:

* Search through ThisWorkbook.Path for files called SOMETHING -
Exceptions.xls e.g. Workbook 1 - Exceptions.xls, Smith - Exceptions.xls etc.
etc.

* Create a directory called "Exceptions" in ThisWorkbook.Path

* Move all the files found with the name above into this Exceptions folder,
leaving all other excel workbooks here with different names.

Any help is greatfully received.

Thanks!!
Dave