Macro copiar hoja en libro existente.

Buen día Dam !

Pues nuevamente solicitando de tu ayuda.
Tengo una pregunta que hasta ahora no el logrado resolver, verás tengo una macro
que me genera alrededor de 150 hojas en el libro MASTER cada una con diferente nombre, aparte tengo una carpeta donde se encuentran alrededor de 200 archivos donde unicamente contienen una sola hoja, los libros de la carpeta se tienen el mismo nombre de la hoja, las hojas del libro MASTER se llaman igual a los archivos que están en la carpeta, espero explicarme bien.
Lo que necesito es que por ejemplo al terminar de generar las hojas del libro MASTER, busque la hoja DULCES, dentro de la carpeta (esa intentar siempre es la misma y los archivos tienen el mismo nombre) bueno me busque la hoja DULCES, en la carpeta y
abra el libro que se llamada DULCES y ahi me peque la hoja del libro MASTER dulces, sin borrar la otra, y que me renombre la hoja nueva de DULCES como chocolates, y asi para todas las hojas que tenga en el libro.


Si alguien pueda ayudarme se los agradezco mucho.
Saludos.

1 respuesta

Respuesta
1

Te anexo la macro

Sub copiar_hoja_a_otro_libro()
'por.dam
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Set l1 = ThisWorkbook.Sheets("Control")
    l1.Activate
    l1.Cells.Clear
    l1.Range("A1:C1") = Array("HOJA", "NUEVO NOMBRE", "MENSAJE")
    carpeta = ThisWorkbook.Path & "\"
    j = 2
    For Each hoja In Worksheets
        Application.StatusBar = "Copiando hoja: " & hoja.Name
        Select Case hoja.Name
            Case "Control"
                mensaje = "Hoja control"
            Case Else
                nombre = hoja.Name & ".xlsx"
                Workbooks.Open carpeta & nombre
                If Err.Number = 0 Then
                    n = Sheets.Count
                    l1.Activate
                    Sheets(hoja.Name).Copy After:=Workbooks(nombre).Sheets(n)
                    If Err.Number = 0 Then
                        mensaje = "Hoja copiada"
                        nvo_nom = "chocolate"
                        ActiveSheet.Name = nvo_nom
                    Else
                        mensaje = "Hoja no pudo copiarse, error: " & Err.Number
                    End If
                    Workbooks(nombre).Save
                    Workbooks(nombre).Close
                Else
                    mensaje = "Archivo no pudo abrirse, error: " & Err.Number
                End If
                j = j + 1
                Err.Number = 0
        End Select
        l1.Cells(j, 1) = hoja.Name
        l1.Cells(j, 2) = nvo_nom
        l1.Cells(j, 3) = mensaje
        nvo_nom = ""
        mensaje = ""
    Next
    l1.Columns("A:C").EntireColumn.AutoFit
Set l1 = Nothing
Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Hojas copiadas", vbInformation, "COPIAS"
End Sub

En tu libro master, crea una hoja llamada “control” para almacenar el resultado de las copias.
En la línea nvo_nom = "chocolate", tienes que poner el nombre de la hoja copiada.

Saludos. DAM

Hola, Dam!! Muchas gracias por tu respuesta, solo que no entiendo muy bien el código, ya lo corrí paso a paso, pero sigo sin comprender, me perdí un poco; anexo ejemplos, para ver si me puedas seguir apoyando. Supongo, que el libro MASTER que contiene la macro debe de estar ubicado dentro de la misma carpeta donde tengo todos mis archivos, correcto?

Por ahora solo me abre todos los libros pero no me copia nada. Se supone que del libro MASTER debe de buscar la hoja CHOCOLATES dentro de la carpeta y ubicar el archivo con el mismo nombre, y asi sucesivamente por cada hoja que este dentro del libro MASTER.

Gracias.

https://www.dropbox.com/s/qpfnlnej2ipvcc4/EJEMPLO.zip

Efectivamente todos los libros tienen que estar en la misma carpeta

Revisa lo siguiente

https://www.dropbox.com/s/5tit0eh82zl60o2/copiahoja.rar

Saludos. DAM

Asi es Dam exactamente es lo que necesito, pero a mi no me copia nada, deja checo que puede ser.

Gracias!!

Dam, del If Err.Number = 0 Then, me manda al END IF, porque sera???

De cuál de los dos err. ¿Number?

Ni siquiera pasa por else?

Comenta estas líneas, para que te aparezca el mensaje de error

Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next

Vuelve a ejecutarlo y me dices que mensaje de error te envía y en dónde se detiene.

Dam ya comente estas lineas y no me da error, ejecuta la macro sin error, pero al final no hace nada se salta el primer err, sip si pasa por el else, pero ya cuando se va al if Err. nada sólito termina el ciclo..

nombre = hoja.Name & ".xlsx"
Workbooks.Open carpeta & nombre
If Err.Number = 0 Then

Archivo no pudo abrirse, error: 13

¿Y la extensión de los libros a abrirse es xls o xlsx o xlsm?

¿Probaste con los archivos que me enviaste?

No se cuál puede ser el problema, ya viste mi vídeo y no tengo fallas.

Haz lo sig:

Antes de If Err.Number = 0

pon esta línea

msgbox err.number

Y me dices qué te aparece

También haz la prueba teniendo el primer archivo abierto, comenta esta línea

Workbooks.Open carpeta & nombre

S2

Uff Dam, no me da, ya hice las pruebas y me arroja un 13, ya verifique la extensión de las hojas y el archivo que utilizo es tal cual el que te envíe, ahora si que estoy en el hoyo.

Je je que raro le puse que:

If Err.Number <> 0 Then


Y gualaaa funciono a la perfección, excel se las gasta bien y bonito!!! Haré mas pruebas. Gracias DAm...

Mmmm, pues está raro, pero si te funciona, es lo importante

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas