Public Sub renamer()

Dim sourcRng As Range
Dim destRng As Range
Set sourcRng = [E6:E22]
Set destRng = [K6:K22]
For i = 1 To sourcRng.Count
If sourcRng.Cells(i).Text <> "" Then
If destRng.Cells(i).Text <> "" Then
    'MsgBox getFolderName(sourcRng.Cells(i).Text) & "\" & destRng.Cells(i).Text
         FileCopy sourcRng.Cells(i).Text, getFolderName(sourcRng.Cells(i).Text) & "\" & destRng.Cells(i).Text
         Kill sourcRng.Cells(i).Text
   End If
   End If
  Next

End Sub

Public Function getFolderName(spath As String) As String
Dim objFSO As Object, strFileName$, strFilePath$
Set objFSO = CreateObject("Scripting.FileSystemObject")
getFolderName = objFSO.GetParentFolderName(spath)
Set objFSO = Nothing
End Function