Macro Excel que seleccione y copie solo una hoja
Espero me puedan ayudar, tengo unos ficheros excel con 4 o 5 hojas y en concreto una que se llama "Producción IRI" (nota siempre esta en la primera hoja), necesito una macro que seleccione sobre unos 40 libros de excel que están en una carpeta (C:/Producción) y copie la hoja "Produción IRI" y la pegue en un nuevo libro y que esa hoja tenga el nombre de la celda "O3" de la misma hoja, es decir, el resultado sera un libro con 40 hojas Producción IRI cambiadas de nombre.
H o l a:
Te anexo la macro para que la pongas en un libro, guarda el libro en otra carpeta diferente a donde tienes los 40 libros.
Sub CopiarUnaHoja() 'Por.Dante Amor Application.ScreenUpdating = False Application.DisplayAlerts = False Application.SheetsInNewWorkbook = 1 ' ruta = "C:\Producción\" 'Carpeta hoja = "Produción IRI" 'Nombre de la hoja a copiar ' Set l2 = Workbooks.Add arch = Dir(ruta & "*xls*") Do While arch <> "" Set l3 = Workbooks.Open(ruta & arch) existe = False For Each h In l3.Sheets If UCase(h.Name) = UCase(hoja) Then existe = True Exit For End If Next If existe Then nuevo = l3.Sheets(hoja).[O3] If nuevo = "" Then nuevo = arch h.Copy after:=l2.Sheets(l2.Sheets.Count) l2.Sheets(l2.Sheets.Count).Name = nuevo End If l3.Close False arch = Dir() Loop l2.Sheets(1).Delete Application.ScreenUpdating = True l2.Activate MsgBox "Copia terminada", vbInformation, "COPIAR UNA HOJA" End Sub
Si es necesario, actualiza en la macro los datos de carpeta y hoja a copiar en estas líneas:
ruta = "C:\Producción\" 'Carpeta
hoja = "Produción IRI" 'Nombre de la hoja a copiar
Dante amor, muchas gracias por tu aporte pero me da un erro en la línea
l2.Sheets(1).Delete
El libro debe contener al menos una hoja visible.
Para eliminar u ocultar la hoja u hojas seleccionadas primero debe insertar una hoja nueva o mostrar alguna hoja oculta.
Los libros no los abre, genera un libro nuevo y creo que es por eso. En cuanto a la ruta esta bien y los ficheros tienen todos 3 o más hojas.
Al dar ese erro se salta toda esta parte:
Do While arch <> "" Set l3 = Workbooks.Open(ruta & arch) existe = False For Each h In l3.Sheets If UCase(h.Name) = UCase(hoja) Then existe = True Exit For End If Next If existe Then nuevo = l3.Sheets(hoja).[O3] If nuevo = "" Then nuevo = arch h.Copy after:=l2.Sheets(l2.Sheets.Count) l2.Sheets(l2.Sheets.Count).Name = nuevo End If l3.Close False arch = Dir() Loop
Muchas gracias por tu ayuda.
Lo que pasa es que ninguno de los libros tiene una hoja llamada :
"Produción IRI"
Revisa que esté bien escrito el nombre de la hoja, tal vez no debe llevar acento, si no lleva acento, entonces quita el acento en la macro.
Prueba nuevamente y me comentas.
Si ya te funciona, recuerda valorar la respuesta.
