VBA loop throught each cell to copy files

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)