Hi There
I am trying to copy a selection of cells(which may vary from time to time)
To a folder location specifed in a cell on the same worksheet.
It works if I specify which cell contents I would like to copy, but not as a selection
I would like the program to know which cell contents are selected and where it should be copied to, based on user selection in the workbook.
Please try to assist if possible
Sub Copy_Certain_Files_In_Folder()
'Declaration
Dim FSO As FileSystemObject
Dim sFile As String, rng
Dim sSFolder As String
Dim sDFolder As String
Set rng = Selection
Sheets("CONTROL").Activate
'This is Your File Name which you want to Copy.You can change File name at B5.
'sFile = Sheets("CONTROL").Range("G8").Value
sFile = Sheets("CONTROL").Range("G8:G500").Resize(rng.Rows.count, _
rng.Columns.count).Value = rng.Value
'sFile = Sheets("CONTROL").Range(Count_Selection)
'Change to match the source folder path. You can change Source Folder name at B6.
sSFolder = Sheets("CONTROL").Range("G7")
'Change to match the destination folder path. You can change Destination Folder name at B6.
sDFolder = Sheets("CONTROL").Range("H7")
'Create Object for File System
Set FSO = CreateObject("Scripting.FileSystemObject")
'Checking If File Is Located in the Source Folder
If Not FSO.FileExists(sSFolder & "\" & sFile) Then
MsgBox "Specified File(sFile) Not Found in Source Folder", vbInformation, "Not Found"
'Copying If the Same File is Not Located in the Destination Folder
ElseIf Not FSO.FileExists(sDFolder & sFile) Then
FSO.CopyFile (sSFolder & "\" & sFile), sDFolder & "\", True
MsgBox "Specified File Copied to Destination Folder Successfully", vbInformation, "Done!"
Else
MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
End If
End Sub
Sub Count_Selection()
Dim cell As Object
Dim count As Integer
count = 0
For Each cell In Selection
count = count + 1
Next cell
MsgBox count & " item(s) selected"
End Sub
Bookmarks