Change destination folder

[leemcder]

Hi, this macro is used to group files in a folder. It created a sub folder in the main folder but I now need it to create the folder in a different location. I've tried doing this myself but having difficulty. Can someone please point me in the correct direction?

Thank you


Sub FindFilesAndMove()
Dim MyFolder As String, MyFile As String, srchStr As String, DestFold As String, FSO As Object, rCell As Range

Set FSO = CreateObject("Scripting.Filesystemobject")
MyFolder = "Y:\accounts\Conv slips" '<<< change to suit
For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells
MyFile = Dir(MyFolder)
srchStr = rCell.Value
DestFold = MyFolder & srchStr & ""
MkDir DestFold
Do While MyFile <> ""
If InStr(MyFile, srchStr) Then
FSO.MoveFile Source:=MyFolder & MyFile, Destination:=DestFold & MyFile
End If
MyFile = Dir
Loop
Next rCell
End Sub

[georgiboy]

Hi Lee,

When posting VBA use the # symbol (Wrap
tags around selected text), it makes it easier to read.

See below for updated code with editable destination folder:

[CODE]Sub FindFilesAndMove()
Dim MyFolder As String, MyFile As String, srchStr As String, DestFoldFull As String, FSO As Object, rCell As Range
Dim DestFold As String

Set FSO = CreateObject("Scripting.Filesystemobject")
MyFolder = "C:\Users\jbloggs\Desktop\test\" '<<< change to suit
DestFold = "C:\Users\jbloggs\Desktop\" '<<< change to suit

For Each rCell In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells
MyFile = Dir(MyFolder)
srchStr = rCell.Value
DestFoldFull = DestFold & srchStr & "\"
MkDir DestFoldFull
Do While MyFile <> ""
If InStr(MyFile, srchStr) Then
FSO.MoveFile Source:=MyFolder & MyFile, Destination:=DestFoldFull & MyFile
End If
MyFile = Dir
Loop
Next rCell
End Sub

[leemcder]

Thanks again mate.