Macro to move specific files from one folder to another folder

[p9j123]

I have a list of files on column A along with their path, I would need help in creating a macro that will move this file to the path in column b.

C:\Origin\test1.xls	C:\Origin\First\
C:\Origin\test2.xls	C:\Origin\Second\
C:\Origin\test3.xls	C:\Origin\Third\
C:\Origin\test4.xls	C:\Origin\Fourth\

 

[DanteAmor]

Try this
Your data should start in cell A2

Sub Rename_and_move_files()
  Dim Path1 As String, Path2 As String, sName As String
  Dim i As Long

  For i = 2 To Range("A" & Rows.Count).End(3).Row
    Path1 = Range("A" & i).Value
    Path2 = Range("B" & i).Value
    If Right(Path2, 1) <> "\" Then Path2 = Path2 & "\"
    sName = Mid(Path1, InStrRev(Path1, "\") + 1)
    If Dir(Path1) <> "" Then
      If Dir(Path2, vbDirectory) <> "" Then
        Name Path1 As Path2 & sName
      End If
    End If
  Next
End Sub

 

[GWteB]

... an alternative could be

Public Sub MoveFilesByList()
    Dim fso As Object, f As Object
    Dim r As Long

    r = 1   'row to start with
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Do While Not IsEmpty(Cells(r, 1))
        If fso.FileExists(Cells(r, 1)) Then
            Set f = fso.GetFile(Cells(r, 1))
                If fso.FolderExists(Cells(r, 2)) Then
                    f.Move Cells(r, 2) & "\"
                Else
                    MsgBox "Folder " & Cells(r, 2) & " doesn't exist"
                End If
        Else
            MsgBox "File " & Cells(r, 1) & " doesn't exist"
        End If
        r = r + 1
    Loop
End Sub

 

[p9j123]

Thank you so much to both of you.

 

[DanteAmor]

Glad we could help & thanks for the feedback