Rename folders to values in excel cell

Hi,

This uses the Name command to change the folder name

Sub ChangeFolderName()
Dim sOldName As String, sNewName As String, sPath As String
Dim rSource As Range, rCell As Range

sPath = "C:\" 'the path of the folders that need renaming
Set rSource = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row) 'the location on the spreadsheet of the current folder names 

For Each rCell In rSource
    sOldName = sPath & rCell.Value 'Old name in column A
    sNewName = sPath & rCell.Offset(0, 1).Value 'new name in column B
    Name sOldName As sNewName 'Changes the name
Next

End Sub

@ sweep

As an example the folder is currently be named 1 and I would need it to be renamed to 1 John Smith.

sNewName = sPath & rCell.Value & " " & rCell.Offset(, 1).Value 'new name in column B

Herewith my spin.....

Sub RenameFolder()
Dim fso As Object, folder As Object, subfolders As Object
Dim i As Long, lRow As Long
Dim NewName As String
lRow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lRow
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder("C:\Users\Steven\Desktop\Folders\")
    Set subfolders = folder.subfolders
    For Each subfolders In subfolders
        If subfolders = folder & "\" & Sheet1.Range("A" & i).Value Then
            NewName = folder & "\" & Sheet1.Range("A" & i).Value & " " & Sheet1.Range("B" & i).Value
            Name subfolders As NewName
            GoTo nxti
        End If
    Next subfolders
nxti:
Next i
End Sub