Experimente (considerando que os dados iniciem em A2/B2)

Option Explicit
Sub BackupGeral()
Dim FSO As Object
Dim NewName As String, cArqu As String
Dim lRow As Long, i As Long
Dim sPath As String

'Obtem caminho onde está o arquivo, se não indicado considera mesmo caminho da planilha aberta
If Sheets("Plan1").Range("K1") = "" Then
    sPath = ThisWorkbook.Path & Application.PathSeparator
Else
    sPath = Sheets("plan1").Range("K1").Value
End If

'Acrescenta a barra se necessario
If Right(sPath, 1) <> "" Then
    sPath = sPath & ""
Else
    sPath = sPath
End If
'Verifica se o diretorio exite, caso não sai da rotina
    If (Dir(sPath, vbDirectory) = "") Then
        MsgBox "Diretório - " & sPath & " Não encontrado?"
        Exit Sub
    End If
'Obtem ultimalinha com dados na coluna A
lRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
'Altera diretorio padrão para onde está o arquivo
ChDir sPath
For i = 2 To lRow

'Novo diretorio
NewName = Sheets("Plan1").Range("B" & i).Value
'Arquivo
cArqu = Sheets("Plan1").Range("A" & i).Value

'Verifica se o diretorio existe, se não existir, cria
    If (Dir(sPath & NewName, vbDirectory) = "") Then
        MkDir (sPath & NewName)
    Else
        MsgBox "Diretório - " & NewName & " Já existe"
    End If
'Verifica se o arquivo já existe, se existir, deleta
    If (Dir(cArqu) = "") Then
        MsgBox "Arquivo - " & cArqu & " Não encontrado"
    End If
'Move o arquivo para o novo diretorio
Set FSO = CreateObject("scripting.filesystemobject")
FSO.MoveFile Source:=sPath & cArqu, Destination:=sPath & NewName & ""
Next
End Sub

Nossa!!, não imaginava que a ajuda viria tão rápido, muito obrigado. Porém o código não está funcionando totalmente certo.

abri uma planilha em branco, na celula K1 coloquei o caminho da pasta base (d:teste)
dentro da pasta base coloquei 14 arquivos com o nome atestado_1.pdf ao atestado_14.pdf
relacionei estes nomes de arquivo na coluna A da planilha a partir da linha 2
na coluna B relacione os nomes das pessoas também a partir da linha 2
copiei o código e colei dentro de um módulo do VBA no Excel e depois mandei executar via macro

ocorreu o seguinte:
erro em tempo de execução: caminho não encontrado
são criadas na pasta base apenas os diretorios referentes aos 3 primeiros nomes que estão na coluna B (JOAO DA SILVA, MARIA JOSE, PAULO RICARDO) e são movidos para dentro de suas respectivas pastas apenas o 1º e o 2º arquivos. ou seja o arquivo atestado_1.pdf é copiado pra dentro da pasta JOAO DA SILVA, o arquivo atestado_2.pdf é movido para a pasta MARIA JOSE, a pasta PAULO RICARDO fica vazia e dá o erro de execução.

oUTRA COISA eu comentei as seguintes linhas do código:
Verifica se o arquivo já existe, se existir, deleta
' If (Dir(cArqu) = "") Then
' MsgBox "Arquivo - " & cArqu & " Não encontrado"
' End If
Pois estava apagando o arquivo da pasta antes de move-lo para a sub-pasta.

é isso.

Antes de "devolver" o codigo, fiz um teste aqui e não tive nenhum dos problemas citados.
Dentro do for ... e criado o diretorio e movido o arquivo. Se possivel disponibilizar seu arquivo (altere nomes se necessario) não precisa enviar os pdf ou jpg que simulo aqui.

Pois é, fiz uma depuração aqui no VBA e não percebi onde tá o erro.

Estou enviando o arquivo.

Aparentemente o erro deve-se ao fato do nome Cleomar ter um caracter adicional no final.
Veja no anexo

era isso mesmo, tinha um caractere " " espaço vazio no final do nome, terei que tratar essas listas antes de jogar aqui.
o resto funcionou muito bem, muito obrigado companheiro. obrigado mesmo. ainda bem que existem pessoas que se dispõe a doar de seu tempo e conhecimento. Deus lhe abençoe.