¿Macro qué copia hojas de un libro a otro desde una lista?
Primero un cordial saludo.
Quiero realizar una macro en excel que me copie las hojas de un libro llamado equipos y la copie en un libro llamado programación, pero que sea a partir de una lista en la hoja 1 del libro programación al cual yo valla colocando los nombres de las hojas del libro equipos y automáticamente lo copie en el libro programación.
¿Es posible?
El proceso se puede hacer en automático con la siguiente macro.
El copiar la hoja es un proceso delicado, por lo que se tienen que verificar lo siguiente:
- Que el libro "equipos.xlsx" exista en la misma ruta del libro "programación", si no existe la macro envía un mensaje de error.
- Que la hoja que quieras copiar ya exista en el libro "programación", si ya existe te envía un mensaje de error.
- Que la hoja exista en el libro "equipos"
Si se cumplen las validaciones, entonces se copia la hoja.
La macro la tienes que poner en los eventos de worksheet, del libro "programación"; funciona de la siguiente manera, cada vez que escribes algo en la columna "A" de la "hoja1" del libro "programación" la macro se activa y en automático copia la hoja.
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
'
Set l1 = ThisWorkbook
ruta = l1.Path
lib_eq = "equipos.xlsx"
hoja = Target.Value
'
For Each h In l1.Sheets
If UCase(h.Name) = UCase(hoja) Then
hojaenlibro = True
Exit For
End If
Next
'
If hojaenlibro Then
MsgBox "La hoja ya existe en este libro", vbExclamation
Exit Sub
End If
'
For Each l In Workbooks
If UCase(l.Name) = UCase(lib_eq) Then
existe = True
Exit For
End If
Next
If existe Then
Set l2 = Workbooks(lib_eq)
Else
If Dir(ruta & "\" & lib_eq) <> "" Then
Set l2 = Workbooks.Open(ruta & "\" & lib_eq)
Else
MsgBox "El libro Equipos.xlsx no está en la ruta", vbCritical
Exit Sub
End If
End If
'
For Each h In l2.Sheets
If UCase(h.Name) = UCase(hoja) Then
hojaequipo = True
Exit For
End If
Next
'
If hojaequipo = False Then
MsgBox "La hoja no existe en el libro Equipo.xlsx", vbExclamation
If existe = False Then l2.Close False
Exit Sub
End If
'
l2.Sheets(hoja).Copy after:=l1.Sheets(l1.Sheets.Count)
If existe = False Then l2.Close False
MsgBox "Hoja copiada con éxito", vbInformation
End SubSigue las Instrucciones para poner la macro en los eventos de worksheet
- Abre tu libro de excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- Del lado izquierdo dice: VBAProject, abajo dale doble click a worksheet(tu hoja)
- Del lado derecho copia la macro
Saludos. Dante Amor
