Crear nueva hoja a varios libros y que esta hoja tenga el formato y contenido de otra hoja?
¿Crear nueva hoja a varios libros y que esta hoja tenga el formato y contenido de otra hoja?
¿Cómo puedo crear nueva hoja a varios libros y que esta nueva hoja tenga el formato y contenido de otra hoja?
Es como tener un hoja de plantilla (con datos y tablas) y querer agregarla a otros libros como otra hoja nueva (asignándole nombre en común "Estructura").
Adjunto código que me permite crear nueva hoja a varios libros en una dirección específica, ojala sea base para mi pregunta.
Les agradecería mucho su ayuda.
Sub NuevaHoja()
'1)Declaro variables
Dim nombreHoja As String
Dim MyFiles As String
'2)Primer filtro
respuesta = MsgBox("Desea agragar hojas nuevas en excel?", vbYesNoCancel, "Agregar")
Select Case respuesta
'3) Si es afirmativa
Case vbYes
'4) Cuenta todos los archivo de extensión xls que hay en la ruta indicada
MyFiles = Dir("C:\Users\clwhmeto\Desktop\METODOS 2015\Fichas incompletas\*.xls")
'5) La macro abrirá el primer archivo
Do While MyFiles <> ""
Workbooks.Open "C:\Users\clwhmeto\Desktop\METODOS 2015\Fichas incompletas\" & MyFiles
'6) Preguntamos al usuario si desea agregar la hoja del archivo que la macro abrió
rpta = MsgBox("Desea agregar nueva hoja a este archivo?", vbYesNo)
If rpta = vbYes Then
nombreHoja = InputBox("Escriba un nombre para la nueva hoja:")
Dim hoja As Worksheet
Set hoja = ActiveWorkbook.Sheets.Add
hoja.Name = nombreHoja
End If
MyFiles = Dir
Loop
Case vbNo
MsgBox "No se agregara hoja, se cerrará el archivo"
ActiveWorkbook.Close SaveChanges:=False
Case vbCancel
MsgBox "Respuesta cancelada"
End Select
1 respuesta
Te anexo la macro con la actualización, cambia en la macro "Hoja1" por la hoja que quieras copiar.
Sub CrearHoja()
'Por.Dante Amor
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Hoja1")
ruta = "C:\Users\clwhmeto\Desktop\METODOS 2015\Fichas incompletas\"
'ruta = "C:\trabajo\"
ChDir ruta
arch = Dir("*.xls*")
'
Do While arch <> ""
Set l2 = Workbooks.Open(arch)
rpta = MsgBox("Desea agregar nueva hoja a este archivo?", vbYesNo)
If rpta = vbYes Then
h1.Copy After:=l2.Sheets(l2.Sheets.Count)
ActiveSheet.Name = "Estructura"
End If
l2.Close False
arch = Dir
Loop
End Sub
Me arroja error '1004', y cuando le hago el paso a paso es en la línea con el código:
h1.Copy After:=l2.Sheets(l2.Sheets.Count)
¿Modificaste algo a la macro?
¿Qué más te dice el error "1004"?
¿El libro que se abre está protegido?
Creo que pasa el error, porque no es capaz de mantener el formato de hoja de origen, que se puede hacer en ese caso??
Me parece que el libro de origen es de una versión 2007 y el archivo destino es versión 2003, por eso la hoja no cabe.
En lugar de copiar la hoja, haríamos lo siguiente: creamos la hoja y copiamos el rango del formato.
Te anexo la macro con el cambio.
Cambia en la macro "A1:M200", por el rango que contiene tu formato
Sub CrearHoja()
'Por.Dante Amor
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Hoja1")
'ruta = "C:\Users\clwhmeto\Desktop\METODOS 2015\Fichas incompletas\"
ruta = "C:\trabajo\"
ChDir ruta
arch = Dir("*.xls*")
'
Do While arch <> ""
Set l2 = Workbooks.Open(arch)
rpta = MsgBox("Desea agregar nueva hoja a este archivo?", vbYesNo)
If rpta = vbYes Then
h1.Range("A1:M200").Copy
Sheets.Add After:=l2.Sheets(l2.Sheets.Count)
ActiveSheet.Name = "Estructura"
ActiveSheet.Paste
End If
l2.Close False
arch = Dir
Loop
End SubSaludos.Dante Amor
Funciona de maravillas, muchas gracias, aunque ahora necesito que mantenga el formato de origen, ancho y alto de celdas, por favor
Eso tendría otro detalle, ya que el alto de fila se tiene que hacer uno por uno.
Podrías crear una nueva pregunta en el tema de excel para copiar el ancho y alto de filas y columnas.
Si lo deseas, al final del título de la nueva pregunta puedes poner que va dirigida a Dante Amor.
