Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
Move Workbooks With Certain Name?
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 |
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
Move Workbooks With Certain Name?
Thanks for that!
Could you possibly remove the section that prints the files that have been moved etc. as this isn't required. Also, how would it be possible to specify different folders to find the excel files rather than them having to be in the directory with the macro workbook. Thanks again Dave "JLatham" wrote: 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 |
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
Move Workbooks With Certain Name?
Then I believe this should do it for you. The function to permit browsing to
choose a folder doesn't permit multiple selections, so it'll be a one-folder at a time operation, but at least you don't have to copy the file to each one in the future. Also did away with echoing moved file names to the workbook. It'll just sit there looking blank until all the work is done - still presents the finished message. As always, test at least once on a copy of the real thing - maybe make a copy of one entire folder and make sure that it works without permanently destroying something it shouldn't. You can just copy and paste over what you had from before. 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 filesMovedCount As Long 'this does not permit multiple folder 'selection, nor will it display files in the 'folder(s) as you work your way to the one 'you want - it will select the current file 'you are looking into when you click the [OK] button With Application.FileDialog(msoFileDialogFolderPicker) .Show If .SelectedItems.Count = 0 Then Exit Sub ' nothing chosen/user [Cancel]'d Else basePath = .SelectedItems(1) & "\" End If End With 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 Else filesMovedCount = filesMovedCount + 1 End If On Error GoTo 0 End If End If anyFile = Dir$() Loop MsgBox filesMovedCount & " " & keyWord & " files moved." End Sub "Dave" wrote: Thanks for that! Could you possibly remove the section that prints the files that have been moved etc. as this isn't required. Also, how would it be possible to specify different folders to find the excel files rather than them having to be in the directory with the macro workbook. Thanks again Dave "JLatham" wrote: 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 |
#5
Posted to microsoft.public.excel.misc
|
|||
|
|||
Move Workbooks With Certain Name?
Hi JLatham,
Once again this code is brilliant thanks! I could do with a couple of amendments if possible? I have two folders that users of my macro will always be browsing to to move files. These a ThisWorkbook.Path & "\FORMATTED" and ThisWorkbook.Path & "\ONE - FORMATTED" Would you be able to integrate these so that there is no need for the browse function? I would then like the exceptions folder to be located at: ThisWorkbook.Path & "\EXCEPTIONS" Would this be possible? Thanks! Dave "JLatham" wrote: Then I believe this should do it for you. The function to permit browsing to choose a folder doesn't permit multiple selections, so it'll be a one-folder at a time operation, but at least you don't have to copy the file to each one in the future. Also did away with echoing moved file names to the workbook. It'll just sit there looking blank until all the work is done - still presents the finished message. As always, test at least once on a copy of the real thing - maybe make a copy of one entire folder and make sure that it works without permanently destroying something it shouldn't. You can just copy and paste over what you had from before. 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 filesMovedCount As Long 'this does not permit multiple folder 'selection, nor will it display files in the 'folder(s) as you work your way to the one 'you want - it will select the current file 'you are looking into when you click the [OK] button With Application.FileDialog(msoFileDialogFolderPicker) .Show If .SelectedItems.Count = 0 Then Exit Sub ' nothing chosen/user [Cancel]'d Else basePath = .SelectedItems(1) & "\" End If End With 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 Else filesMovedCount = filesMovedCount + 1 End If On Error GoTo 0 End If End If anyFile = Dir$() Loop MsgBox filesMovedCount & " " & keyWord & " files moved." End Sub "Dave" wrote: Thanks for that! Could you possibly remove the section that prints the files that have been moved etc. as this isn't required. Also, how would it be possible to specify different folders to find the excel files rather than them having to be in the directory with the macro workbook. Thanks again Dave "JLatham" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Move worksheets into separate workbooks | New Users to Excel | |||
How do I stop making the spreadsht move when I move up/dwn/lt/rt? | Excel Worksheet Functions | |||
How can I move multiple linked workbooks between computers | Excel Discussion (Misc queries) | |||
How do you move names and data between large Excel 2003 workbooks? | Excel Worksheet Functions | |||
How do I move workbooks w/o having to reset the links? | New Users to Excel |