Macro Copiar solo hojas visibles incluyendo las imágenes y pegar en archivo nuevo
Tengo una macro que me copia solo las hojas que están en la variable array y me las pega en un libro nuevo. Lo que necesito es que la macro me copie todas las hojas visibles (las ocultas no) que tiene el archivo, pero que tambien se copien las imágenes que estos contienen y todo esto sea pegado en un nuevo libro con pegado especial "valores". Gracias de antemano. Anexo la macro.
Sub copia3hojas()
Application.ScreenUpdating = False
On Error Resume Next
Set l1 = ThisWorkbook
Workbooks.Add
Set l2 = ActiveWorkbook
H = Array("Propuesta N° 1", "Propuesta N°2", "Propuesta N°3", "Propuesta N°4", "Propuesta N°5", "Propuesta N°6", "Propuesta N°7", "Propuesta N°8", "Propuesta N°9", "Propuesta N°10")
'
For i = UBound(h) To LBound(h) Step -1
Sheets.Add
n = ActiveSheet.Name
l1.Sheets(h(i)).Cells.Copy '
l2.Sheets(n).Range("A1").PasteSpecial Paste:=xlPasteValues
l2.Sheets(n).Range("A1").PasteSpecial Paste:=xlPasteFormats
l2.Sheets(n).Name = h(i)
Next
End Sub
1 Respuesta
Agrega la siguiente línea a tu código para pegar las imágenes contenidas en la hoja
L2. Sheets(n). Pictures. Paste.Select
y para que solamente pegues las hojas visibles, usa la siguiente condición .
If l1.Sheets(h(i)).Visible Then
Tu código puede quedar así:
Sub copia3hojas()
Application.ScreenUpdating = False
On Error Resume Next
Set l1 = ThisWorkbook
Workbooks.Add
Set l2 = ActiveWorkbook
H = Array("Propuesta N° 1", "Propuesta N°2", "Propuesta N°3", "Propuesta N°4", "Propuesta N°5", "Propuesta N°6", "Propuesta N°7", "Propuesta N°8", "Propuesta N°9", "Propuesta N°10")
'
For i = UBound(h) To LBound(h) Step -1
Sheets.Add
n = ActiveSheet.Name
If l1.Sheets(h(i)).Visible Then
l1.Sheets(h(i)).Cells.Copy '
l2.Sheets(n).Range("A1").PasteSpecial Paste:=xlPasteValues
l2.Sheets(n).Range("A1").PasteSpecial Paste:=xlPasteFormats
l2.Sheets(n).Pictures.Paste.Select
l2.Sheets(n).Name = h(i)
End If
Next
End Sub
Jose Saul muchas gracias por tu presteza en responde. Amigo lo de la imagen no me funcionó porque al colocar esa sentencia lo que hace es hacer un capture del archivo, y lo que necesito es que copie el logo de la empresa y lo pegue en las hojas del nuevo archivo.
Por otra parte, lo que quería también es ver si hay alguna manera de eliminar el "array" para no tener que colocar el nombre de las hojas específicamente, sino que la macro me copie todas las hojas visibles que haya en el archivo. Esto porque pueden haber 2 o 10 o 20 propuestas. Lo intenté coloca Foer Each Hoja in ths workbook pero al colocar eso no funciona esta línea
For i = UBound(h) To LBound(h) Step -1
Intenta con el siguiente código.
Sub copia3hojas()
Application.ScreenUpdating = False
On Error Resume Next
Set l1 = ThisWorkbook
Workbooks.Add
Set l2 = ActiveWorkbook
For I = 0 To l1.Worksheets.Count
Sheets.Add
n = ActiveSheet.Name
If l1.Worksheets(I).Visible Then
l1.Worksheets(I).Cells.Copy
l2.Worksheets(n).Range("A1").PasteSpecial Paste:=xlPasteValues
l2.Worksheets(n).Range("A1").PasteSpecial Paste:=xlPasteFormats
l1.Worksheets(I).Shapes.Range(Array("Picture 2")).Select
Selection.Copy
l2.Worksheets(n).Paste
l2.Worksheets(n).Name = h(I)
End If
Next
End SubComo puedes ver cambia el arreglo por "Worksheets" que es la clase de Excel que almacena las hojas de calculo, no confundir con Sheets, porque esta otra clase almacena todas las hojas del libro incluyendo las de gráficos. Para el tema de tu logotipo usa el nombre de la imagen en esté ejemplo se llama "Picture 2".
