Copiar hoja de un libro a todos los libros de una carpeta?
Quisiera copiar la hoja "Portada2" del libro OK.xlsm a todos los libros de Excel que estén en cierta carpeta, hasta ahora lo he intentado con este código pero me da error de compilación.
Sub copiado_hojas()
Dim Libro_destino As String
Libro_destino = Application.GetOpenFilename
Workbooks.Open Libro_destino
ThisWorkbook.Activate
Sheets("Portada2").Select
Workbooks("Libro_destino").Activate
Sheets("Portada2").Copy Before:=Workbooks("Libro_destino").Sheets("Portada")
Sheets("Portada").Select
Range("A16:P30").Select
Selection.Copy
Sheets("Portada2").Select
Range("A16").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Portada").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
Sheets("Portada2").Select
Sheets("Portada2").Name = "Portada"
Cells.Replace What:="[OK.xlsm]", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
1 respuesta
Te anexo la macro
Pon el libro con la hoja "portada2" en una carpeta diferente de donde tienes los libros destino
Cambia esta línea "C:\trabajo\libros\" por el nombre de tu carpeta donde tienes los libros destino.
La macro abrirá cada libro y le insertará al inicio la hoja "portada2"
Sub Copiar_Hoja_A_Libros()
'Por. Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Portada2")
carpeta = "C:\trabajo\libros\"
arch = Dir(carpeta & "*.xls*")
Do While arch <> ""
Set l2 = Workbooks.Open(carpeta & arch)
h1.Copy before:=l2.Sheets(1)
l2.Save
l2.Close False
arch = Dir()
Loop
MsgBox "Fin"
End SubPrueba y me comentas
Sal u dos. No olvides valorar la respuesta
.
