Copiar datos de un libro a otro y que me copie también las fotos

Dante me ayudo a crear este código.

Sub IngresarDatos()
'
' Ingresar_Datos Macro
'

    Application.ScreenUpdating = False
    Sheets("DataBase Bewerber").Select
    Range("A5").Select
    Selection.ListObject.ListRows.Add (1)
    Sheets("Bewerber einfügen").Select
    Range("C6:C22").Select
    Selection.Copy
    Sheets("DataBase Bewerber").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
        ActiveWorkbook.Worksheets("DataBase Bewerber").ListObjects("DataBase"). _
        Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DataBase Bewerber").ListObjects("DataBase"). _
        Sort.SortFields.Add Key:=Range("DataBase[[#All],[ID No.]]"), SortOn:= _
        xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("DataBase Bewerber").ListObjects("DataBase" _
        ).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("Bewerber einfügen").Select
    Application.CutCopyMode = False
    Range("C6:C22").Select
    Selection.ClearContents
    Range("C3").Select
'For J = 2 To 5000
'If Sheet4.Cells(J, 2) = "" Then
 'H = J
'Exit For
'End If
'Next J
'Sheet4.Cells(H, 2) = Sheet2.Cells(3, 3)
'Sheet4.Cells(H, 3) = Sheet2.Cells(3, 5)
'Range("E3") = Range("E3").Value + 1
    Application.ScreenUpdating = True
End Sub

Sub SaveInformation()

For i = 5 To 100
If Sheet61.Cells(i, 2) = "" Then
 p = i
Exit For
End If
Next i
Application.ScreenUpdating = False
Sheet61.Cells(i, 1) = Sheet96.Cells(3, 3)
Sheet61.Cells(i, 2) = Sheet96.Cells(6, 3)
Sheet61.Cells(i, 3) = Sheet96.Cells(7, 3)
Sheet61.Cells(i, 4) = Sheet96.Cells(9, 3)
Sheet61.Cells(i, 5) = Sheet96.Cells(10, 3)
Sheet61.Cells(i, 6) = Sheet96.Cells(11, 3)
Sheet61.Cells(i, 7) = Sheet96.Cells(12, 3)
Sheet61.Cells(i, 8) = Sheet96.Cells(13, 3)
Sheet61.Cells(i, 9) = Sheet96.Cells(15, 3)
Sheet61.Cells(i, 10) = Sheet96.Cells(17, 3)
Sheet61.Cells(i, 11) = Sheet96.Cells(18, 3)
Sheet61.Cells(i, 12) = Sheet96.Cells(19, 3)
Sheet61.Cells(i, 13) = Sheet96.Cells(21, 3)
Sheet61.Cells(i, 14) = Sheet96.Cells(22, 3)

For J = 2 To 100
If Sheet62.Cells(J, 10) = "" Then
 H = J
Exit For
End If
Next J
Sheet62.Cells(J, 10) = Sheet96.Cells(6, 3)
Sheet62.Cells(J, 11) = Sheet96.Cells(3, 3)
Sheet62.Cells(J, 12) = Sheet96.Cells(3, 3)

MsgBox "gespeichert!"

Sheet96.Cells(3, 3) = Sheet96.Cells(3, 3) + 1
For i = 6 To 22
Sheet96.Cells(i, 3) = ""
Next i
Application.ScreenUpdating = True
End Sub

Pero al ejecutarlos me di cuenta de que los datos de los empleados se copian sin las respectivas Fotos. El problema es que las Fotos están en una hoja a parte.

Como puedo Hacer para copiar las Fotos en la hoja donde están las Fotos de los empleados en el nuevo libro.

por ejemplo en la hoja5 estan las Fotos

Y en la hoja3 hay una planilla de comtrol de empleados que cuando se escribe el código del empleado llama la información del mismo en la base de datos que se encuenta en la hoja2 y la Foto que se encuentra en la hoja 5 y se ve así.

El problema es además que la persona que usara este programa no conoce los id de los empleados así que la busque de empleados aquí se debería Hacer por normbre y no por ID.

Como lo hago.

Añade tu respuesta

Haz clic para o