Add cell value to folder name
Hello, I am using this macro to find files and move them to a folder. The folder created uses the contents in column A as the folder name. I'd like the folder to now use column A and column B as the folder name. I've tried a few things and it hasn't work. Please can someone help. Thank you
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 = "Y:\Accounts Conveyancing Shared\Populated completion documents\" '<<< change to suit
DestFold = "Y:\Accounts Conveyancing Shared\Completions\Auto completion packs\" '<<< 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 & rCell & "\"
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
MsgBox ("Pack Creation Successful")
End Sub
End Sub
