Moving subfolders to another folder.

Completely untested:

Sub lwk()
    Const sDirFr    As String = "C:\myPathFr\"
    Const sDirTo    As String = "C:\myPathTo\"
    Dim sFile       As String
    Dim iRow        As Long

    For iRow = 2 To Cells(Rows.Count, "A")
        sFile = Cells(iRow, "A").Value2
        If Len(Dir(sDirFr & sFile)) Then
            Name sDirFr & sFile As _
                 sDirTo & sFile & " - " & Cells(iRow, "A").Value2
        End If
    Next iRow
End Sub

That's not much help.

What's the exact code you're using? What happens when you step through it?

I am using the code below. Changing the to and from path. No action occurs when i run it. No errors either.

Sub lwk()
    Const sDirFr    As String = "C:\Users\Lucas\Desktop\From"
    Const sDirTo    As String = "C:\Users\Lucas\Desktop\To"
    Dim sFile       As String
    Dim iRow        As Long

    For iRow = 2 To Cells(Rows.Count, "A")
        sFile = Cells(iRow, "A").Value2
        If Len(Dir(sDirFr & sFile)) Then
            Name sDirFr & sFile As _
                 sDirTo & sFile & " - " & Cells(iRow, "A").Value2
        End If
    Next iRow
End Sub

You're missing the trailing path separators on the directories.

OK.. I added the trailing path separators but still nothing is happening. I have the From folder sitting on my desktop as well to To folder. In the From folder I have a subfolder named Abbatiello,Phillip.

Nothing is happening when I run the code below. I also uploaded the Excel file I am using.

Sub lwk()
    Const sDirFr    As String = "C:\Users\Lucas\Desktop\From\"
    Const sDirTo    As String = "C:\Users\Lucas\Desktop\To\"
    Dim sFile       As String
    Dim iRow        As Long

    For iRow = 2 To Cells(Rows.Count, "A")
        sFile = Cells(iRow, "A").Value2
        If Len(Dir(sDirFr & sFile)) Then
            Name sDirFr & sFile As _
                 sDirTo & sFile & " - " & Cells(iRow, "A").Value2
        End If
    Next iRow
End Sub

.

Hi. Also I found some VBA code that just moves subfolders to another folder. Does this help?

Sub Copy_Folder()
'This example copy all files and subfolders from FromPath to ToPath.
'Note: If ToPath already exist it will overwrite existing files in this folder
'if ToPath not exist it will be made for you.
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String

    FromPath = "C:\Users\Lucas\Desktop\From"  '<< Change
    ToPath = "C:\Users\Lucas\Desktop\To"  '<< Change

    'If you want to create a backup of your folder every time you run this macro
    'you can create a unique folder with a Date/Time stamp.
    'ToPath = "C:\Users\Ron\" & Format(Now, "yyyy-mm-dd h-mm-ss")

    If Right(FromPath, 1) = "\" Then
        FromPath = Left(FromPath, Len(FromPath) - 1)
    End If

    If Right(ToPath, 1) = "\" Then
        ToPath = Left(ToPath, Len(ToPath) - 1)
    End If

    Set FSO = CreateObject("scripting.filesystemobject")

    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If

    FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath

End Sub

There's no extension in the filenames ...

This is a folder name not a file.

Const sDirFr As String = "C:\Users\Lucas\Desktop\From\"
Const sDirTo As String = "C:\Users\Lucas\Desktop\To\"

I completely missed that.

Sub lwk()
    Const sDirFr    As String = "C:\Users\Lucas\Desktop\From\"
    Const sDirTo    As String = "C:\Users\Lucas\Desktop\To\"
    Dim sFile       As String
    Dim iRow        As Long

    For iRow = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        sFile = Cells(iRow, "A").Value2
        If Len(Dir(sDirFr & sFile, vbDirectory)) Then
            If GetAttr(sDirFr & sFile) And vbDirectory Then
                Name sDirFr & sFile As _
                     sDirTo & sFile & " - " & Cells(iRow, "B").Value2
            End If
        End If
    Next iRow
End Sub

You're welcome.