Guardar las imágenes en carpeta

Disculpa pero no entiendo qué es lo que necesitas.

¿Quieres crear un hipervinculo?

¿O quieres poner una imagen en excel?

¿O quieres pasar una imagen a una carpeta?

Puede comentarme

En la imagen aparecen todos los empleados y en la columna C un  hipervínculo que me mostraría su foto. Lo que quisiera sería una carpeta por cada grupo de edades que contendría el fichero excel  de todos los que tienen la misma edad así como los ficheros de las fotos de cada uno de ellos. Por ejemplo, habria una carpeta que podría llamarse "Edad_34" que contendría un fichero excel con 3 registros (Jose, Patricia y Josema) y en esa misma carpeta estarían sus ficheros de fotos. Espero haber sido claro. Un saludo y Gracias.

Quieres lo siguiente, por ejemplo

1. Pasar los nombres de edad 34 a un archivo, llamado "34"

2. Crear una carpeta nueva llamada "edad_34"

3. Guardar el archivo "34" en la carpeta "edad_34". ¿Correcto?

4. Copiar los archivos de las fotos a la carpeta "edad_34". ¿Y en dónde están los archivos con las fotos?

5. Ahora, el hipervinculo actual de la persona a punta a cierta carpeta, ¿pero ahora quieres que apunte a la carpeta "edad_34"?

Bueno, son varas peticiones en una misma pregunta, la macro para el punto 1 ya la tienes, voy a enviarte la macro para crear las nuevas carpetas contestando a esta pregunta, pero deberás crear una pregunta para el punto 3, otra pregunta para el punto 4 y otra para el punto 5. Y en cada pregunta me respondes a las dudas que tengo.

Te anexo la macro para crear las carpetas.

Sub CrearLibros()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ruta = ThisWorkbook.Path
    '
    Set h1 = ActiveSheet
    h1.Cells.Copy
    Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
    ActiveSheet.Paste
    Application.CutCopyMode = False
    '
    u = h2.Range("B" & Rows.Count).End(xlUp).Row
    With h2.Sort
     .SortFields.Clear: .SortFields.Add Key:=h2.Range("B2:B" & u)
     .SetRange h1.Range("A1:B" & u): .Header = xlYes: .Apply
    End With
    '
    ant = h2.Cells(2, "B")
    Set l3 = Workbooks.Add
    Set h3 = l3.ActiveSheet
    h2.Rows(2).Copy h3.[A1]
    j = 2
    u = h2.Range("B" & Rows.Count).End(xlUp).Row
    '
    For i = 3 To u + 1
        If ant <> h2.Cells(i, "B") Then
            MkDir ruta & "\Edad_" & ant
            l3.SaveAs ruta & "\Edad_" & ant & "\" & ant
            l3.Close
            If u < i Then Exit For
            Set l3 = Workbooks.Add
            Set h3 = l3.ActiveSheet
            j = 1
        End If
        h2.Rows(i).Copy h3.Range("A" & j)
        j = j + 1
        ant = h2.Cells(i, "B")
    Next
    h2.Delete
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.

Está fenómeno, pero cada carpeta también debía incluir las imágenes (fotos) de cada uno que figura en el fichero xls