Cerrar todos los libros menos el activo

Estoy realizando una macro la cual me va a permitir copiar varias celdas de otros libros en diferentes hojas, el problema es que cuando pega los datos me deja todos los libros abiertos, y tengo que cerrarlos manualmente, mi rutina es la siguiente y pues me gustaría que se cerraran automáticamente.

Rutina:

Sub abrircortemat()
Dim Respuesta
Range("C2").Select
MsgBox "Recuerda abrir el libro de Schatz"
Respuesta = Application.Dialogs(xlDialogOpen).Show
If Respuesta = False Then Exit Sub
nombre = ActiveWorkbook.Name
Range("C17,C18,C19,C20,C21,C24,C25").Select
Range("C25").Activate
Selection.Copy
Windows("gastos mensuales 2012 viri3.xlsm").Activate
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("C2").Select
MsgBox "Recuerda abrir el libro de Hacker"
Respuesta = Application.Dialogs(xlDialogOpen).Show
If Respuesta = False Then Exit Sub
nombre = ActiveWorkbook.Name
Range("C17,C18,C19,C20,C21,C24,C25").Select
Range("C25").Activate
Selection.Copy
Windows("gastos mensuales 2012 viri3.xlsm").Activate
Sheets("hacker").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("C2").Select
MsgBox "Recuerda abrir el libro de Nantli"
Respuesta = Application.Dialogs(xlDialogOpen).Show
If Respuesta = False Then Exit Sub
nombre = ActiveWorkbook.Name
Range("C17,C18,C19,C20,C21,C24,C25").Select
Range("C25").Activate
Selection.Copy
Windows("gastos mensuales 2012 viri3.xlsm").Activate
Sheets("nantli").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("C2").Select
MsgBox "Recuerda abrir el libro de Amoxcalli"
Respuesta = Application.Dialogs(xlDialogOpen).Show
If Respuesta = False Then Exit Sub
nombre = ActiveWorkbook.Name
Range("C17,C18,C19,C20,C21,C24,C25").Select
Range("C25").Activate
Selection.Copy
Windows("gastos mensuales 2012 viri3.xlsm").Activate
Sheets("amoxcalli").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("C2").Select
MsgBox "Recuerda abrir el libro de Mannschaft"
Respuesta = Application.Dialogs(xlDialogOpen).Show
If Respuesta = False Then Exit Sub
nombre = ActiveWorkbook.Name
Range("C17,C18,C19,C20,C21,C24,C25").Select
Range("C25").Activate
Selection.Copy
Windows("gastos mensuales 2012 viri3.xlsm").Activate
Sheets("mann").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("C2").Select
MsgBox "Recuerda abrir el libro de Notza"
Respuesta = Application.Dialogs(xlDialogOpen).Show
If Respuesta = False Then Exit Sub
nombre = ActiveWorkbook.Name
Range("C17,C18,C19,C20,C21,C24,C25").Select
Range("C25").Activate
Selection.Copy
Windows("gastos mensuales 2012 viri3.xlsm").Activate
Sheets("notza").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub

1 respuesta

Respuesta
1

Utiliza el siguiente código, si quieres ponlo al final de tu macro, o manda a llamarlo en el lugar donde lo necesites.

Sub cierralibros()
'por.dam
este = ThisWorkbook.Name
For Each wkb In Workbooks
    Select Case wkb.Name
    Case este
        'MsgBox "este no se cierra"
    Case Else
        Workbooks(wkb.Name).Close
    End Select
Next
End Sub

Saludos.Dam
Si es lo que necesitas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas