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

Respuesta
2

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 Sub

Como 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".

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas