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.