VBA loop throught each cell to copy files - vba

Question

I have an Excel file where columns (icol) each cells contains a path of some files like this :
column A column B column c
P:\Desktop\Source\Test1-folder\file1.txt empty column P:\Desktop\Source\Test1-folder\filetest.txt
P:\Desktop\Source\Test1-folder\file2.txt .....
and I need to loop through these cells to copy files from the cells into destination folder, but i couldn't succeed .Can anyone help how to do it?
Dim strSlash As String, destinationFolder As String
Dim lastcolumn As Long, icol As Long, lastLigne As Long
Dim rngCell As Range, rngFiles As Range
Dim FSO As New FileSystemObject
destinationFolder = "P:\Desktop\folderdestination"
Dim maListe As Object
Dim workboo As Workbook
Dim worksh As Worksheet
Set workboo = Workbooks.Open(P:\Desktop\Source\excelfile.xlsx)
Set worksh = workboo.Worksheets("path_files")
lastcolumn = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
If Dir(destinationFolder, 16) = "" Then MkDir (destinationFolder)
For icol = 1 To lastcolumn Step 2
lastLigne = Cells(Rows.Count, icol).End(xlUp).Row
Set rngFiles = Cells(1, icol).Resize(lastLigne)
For Each rngCell In rngFiles.Cells
If Dir(rngCell.Value) <> "" Then
strFile = Right(rngCell.Value, Len(rngCell.Value) - InStrRev(rngCell.Value, "\"))
If Dir(destinationFolder & "\" & Left(strFile, 5) , 16) = "" Then
FSO.CopyFile rngCell.Value, destinationFolder & "\" & Left(strFile, 5)
End If
End If
Next rngCell
Next icol
end sub

Answer 1

edited to add a check for source file existence
this should do
Option Explicit
Sub main()
Dim strSlash As String, destinationFolder As String
Dim lastcolumn As Long, icol As Long, lastLigne As Long
Dim rngCell As Range, rngFiles As Range
Dim FSO As New FileSystemObject
strSlash = "\"
destinationFolder = "P:\Desktop\folderdestination"
lastcolumn = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
For icol = 1 To lastcolumn Step 2
lastLigne = Cells(Rows.Count, icol).End(xlUp).Row
Set rngFiles = Cells(1, icol).Resize(lastLigne)
For Each rngCell In rngFiles.Cells
If Dir(rngCell.Value) <> "" Then '<~~ check if the source file is actually there!
If Dir(destinationFolder & "\" & Right(rngCell.Value, Len(rngCell.Value) - InStrRev(rngCell.Value, strSlash)), 16) = "" Then
FSO.CopyFile rngCell.Value, destinationFolder & "\" & Right(rngCell.Value, Len(rngCell.Value) - InStrRev(rngCell.Value, strSlash))
End If
End If
Next rngCell
Next icol
End Sub
but it could still be improved to a good extent, exploiting FileSystemObject more thoroughly (which of course needs adding reference to "Microsoft Scripting Runtime" library: Tools->References and then scroll down List Box and select "Microsoft Scripting Runtime" checkbox)