Qué tal, Os dejo algunas macros para trabajar con libros cerrados. Con estas macros he conseguido modificar más de 900 archivos sin tener que abrir uno por uno. Cualquier recomendación de mejora de las mismas será bienvenida :) Para que funcionen estas macros (A, B y C) es necesario: - 1º Tener en una hoja del libro abierto, un listado de los ficheros a modificar con ruta completa y nombre de archivo y tenerla activa y con el fichero/s a modificar seleccionados, sino las macros darán error. Yo lo he realizado con la opción de la plaicación de este foro EXCELeINFO. Estas 3 primeras macros modifican directamente celdas, filas, etc. en los ficheros cerrados A) MACRO PARA INSERTAR FILAS/COLUMNAS EN FUNCIÓN DEL VALOR DE ALGUNA CELDA DEL LIBRO CERRADO. En esta macro se comprueba el valor de alguna celda, si existe/no existe se insertan una serie de filas. Aparte se modifica el valor (texto de una celda) Sub Insertar_Filas_Con_Condicional_XLCerrados() 'Declaramos variables Dim Archivo As Application Dim Celda As Object Dim NombreArchivo As String ' 'Creamos el objecto Excel Set Archivo = CreateObject("Excel.Application") ' With Archivo ' 'Recorremos cada celda de la selección para tomar el nombre de cada archivo For Each Celda In Selection NombreArchivo = Celda.Value ' 'Validamos si el archivo ya está abierto If IsFileOpen(NombreArchivo) Then Else ' With .Workbooks.Open(NombreArchivo) 'Hacemos las modificaciones en el archivo en fucnción del valor de una celda If .Worksheets("Hoja1").Range("O53:O54").Value <> "MONTAJE" Then .Worksheets("Hoja1").Range("H45:I46").Select .Worksheets("Hoja1").Range("H35:I36").EntireRow.Insert Shift:=xlDown .Worksheets("Hoja1").Range("H35:I36").Merge .Worksheets("Hoja1").Range("J35:J36").Merge .Worksheets("Hoja1").Range("K35:K36").Merge .Worksheets("Hoja1").Range("L35:L36").Merge .Worksheets("Hoja1").Range("M35:M36").Merge .Worksheets("Hoja1").Range("N35:Q36").Merge .Worksheets("Hoja1").Range("H35").Value = "MONTAJE" End If 'Cerramos el archivo guardando cambios .Close SaveChanges:=True End With End If ' Next Celda ' 'Cerramos la aplicación de Excel .Quit End With End Sub Sub vercerrados() Function IsFileOpen(filename As String) Dim fileNum As Integer, errNum As Integer ' On Error Resume Next ' Turn error checking off. fileNum = FreeFile() ' Get a free file number. ' Attempt to open the file and lock it. Open filename For Input Lock Read As #fileNum Close fileNum ' Close the file. errNum = Err ' Save the error number that occurred. On Error GoTo 0 ' Turn error checking back on. ' Check to see which error occurred. Select Case errNum ' No error occurred. ' File is NOT already open by another user. Case 0 IsFileOpen = False ' Error number for "Permission Denied." ' File is already opened by another user. Case 70 IsFileOpen = True ' Another error occurred. End Select End Function B) MACRO PARA ESTABLECER EL ÁREA DE IMPRESIÓN En esta macro primero establecemnos los anchos de columna necesarios y el alto de fila de cierto rango. Luego establecemos el área de impresión, márgenes, centrado, etc. Sub Modificar_Area_Impresion() 'Declaramos variables Dim Archivo As Application Dim Celda As Object Dim NombreArchivo As String Dim pgsRange As Range ' 'Creamos el objecto Excel Set Archivo = CreateObject("Excel.Application") ' With Archivo ' 'Recorremos cada celda de la selección para tomar el nombre de cada archivo For Each Celda In Selection NombreArchivo = Celda.Value ' 'Validamos si el archivo ya está abierto If IsFileOpen(NombreArchivo) Then Else ' With .Workbooks.Open(NombreArchivo) 'Establecemos los anchos de columnas que necesitamos .Worksheets("Hoja1").Activate .Worksheets("Hoja1").Range("H55:H75").RowHeight = 20 .Worksheets("Hoja1").Columns("H:H").ColumnWidth = 22 .Worksheets("Hoja1").Columns("I:I").ColumnWidth = 22 .Worksheets("Hoja1").Columns("J:J").ColumnWidth = 20 .Worksheets("Hoja1").Columns("K:K").ColumnWidth = 27 .Worksheets("Hoja1").Columns("L:L").ColumnWidth = 41 .Worksheets("Hoja1").Columns("M:M").ColumnWidth = 37 .Worksheets("Hoja1").Columns("N:N").ColumnWidth = 28 .Worksheets("Hoja1").Columns("O:O").ColumnWidth = 53 .Worksheets("Hoja1").Columns("P:P").ColumnWidth = 48 .Worksheets("Hoja1").Columns("Q:Q").ColumnWidth = 25 'Seleccionar área de Impresión .Worksheets("Hoja1").Range("H2:Q76").Select 'Establecemos el área de Impresión With .ActiveSheet.PageSetup .PrintArea = "" .PrintArea = "H2:Q76" .LeftMargin = Application.InchesToPoints(0) .RightMargin = Application.InchesToPoints(0) .TopMargin = Application.InchesToPoints(0) .BottomMargin = Application.InchesToPoints(0) .HeaderMargin = Application.InchesToPoints(0) .FooterMargin = Application.InchesToPoints(0) .CenterHorizontally = True .CenterVertically = True End With 'Cerramos el archivo guardando cambios .Close SaveChanges:=True End With End If ' Next Celda ' 'Cerramos la aplicación de Excel .Quit End With End Sub Sub vercerrados() Function IsFileOpen(filename As String) Dim fileNum As Integer, errNum As Integer ' On Error Resume Next ' Turn error checking off. fileNum = FreeFile() ' Get a free file number. ' Attempt to open the file and lock it. Open filename For Input Lock Read As #fileNum Close fileNum ' Close the file. errNum = Err ' Save the error number that occurred. On Error GoTo 0 ' Turn error checking back on. ' Check to see which error occurred. Select Case errNum ' No error occurred. ' File is NOT already open by another user. Case 0 IsFileOpen = False ' Error number for "Permission Denied." ' File is already opened by another user. Case 70 IsFileOpen = True ' Another error occurred. End Select End Function C) MACRO PARA MODIFCAR VALOR DE ALGUNA CELDA En esta macro simplemente modificamos el valor de alguna celda del archivo cerrado: Sub Modificar_Texto_Celdas_XLCerrados() 'Declaramos variables Dim Archivo As Application Dim Celda As Object Dim NombreArchivo As String ' 'Creamos el objecto Excel Set Archivo = CreateObject("Excel.Application") ' With Archivo ' 'Recorremos cada celda de la selección para tomar el nombre de cada archivo For Each Celda In Selection NombreArchivo = Celda.Value ' 'Validamos si el archivo ya está abierto If IsFileOpen(NombreArchivo) Then Else ' With .Workbooks.Open(NombreArchivo) 'Hacemos las modificaciones en el archivo .Worksheets("Hoja1").Range("A1").Value = "Total" .Worksheets("Hoja1").Range("A2").Value = 10 'Cerramos el archivo guardando cambios .Close SaveChanges:=True End With End If ' Next Celda ' 'Cerramos la aplicación de Excel .Quit End With End Sub Sub vercerrados() Function IsFileOpen(filename As String) Dim fileNum As Integer, errNum As Integer ' On Error Resume Next ' Turn error checking off. fileNum = FreeFile() ' Get a free file number. ' Attempt to open the file and lock it. Open filename For Input Lock Read As #fileNum Close fileNum ' Close the file. errNum = Err ' Save the error number that occurred. On Error GoTo 0 ' Turn error checking back on. ' Check to see which error occurred. Select Case errNum ' No error occurred. ' File is NOT already open by another user. Case 0 IsFileOpen = False ' Error number for "Permission Denied." ' File is already opened by another user. Case 70 IsFileOpen = True ' Another error occurred. End Select End Function Para que funcionen esta macros (D) es necesario: - 1º Tener en una hoja del libro abierto, un listado de los ficheros a modificar con ruta completa y nombre de archivo y tenerla activa y con el fichero/s a modificar seleccionados, sino las macros darán error. Yo lo he realizado con la opción de la plaicación de este foro EXCELeINFO. - 2º En otra hoja del libro abierto, tener los datos, filas, etc que queremos modificar en los ficheros cerrados. En esta macro tenemos las filas a modificar en el fichero que tenemos abierto con la ruta de los ficheros cerrados y en otra hoja el formato de hoja modificado. De esta segunda hoja cogeremos los datos para modificar los ficheros cerrados. Esta macro ha sido creada por nuestro compañero de foro, como véis es mucho más elegante y funcional que las que yo he creado :D :P D) MACRO PARA INSERTAR TODO UN RANGO DE CELDAS EN LOS FICHEROS CERRADOS Sub Copiar_a_libros_cerrados() Dim Rng As Range, C As Range Application.ScreenUpdating = False Set Rng = Sheets("CELDAS A COPIAR").[O54:Q55] Selection.Interior.ColorIndex = xlColorIndexNone For Each C In Selection Select Case IsFileOpen(CStr(C)) Case False With Workbooks.Open(CStr(C)).Sheets("Hoja1").[O54:Q55] .UnMerge Rng.Copy .Cells: .Cells = Rng.Value .Worksheet.Parent.Close True End With Case True C.Interior.Color = vbGreen End Select Next Application.ScreenUpdating = True End Sub Function IsFileOpen(filename As String) As Boolean Dim fileNum As Integer, errNum As Integer ' fileNum = FreeFile() ' Get a free file number. ' Attempt to open the file and lock it. On Error Resume Next ' Turn error checking off. Open filename For Input Lock Read As #fileNum Close fileNum ' Close the file. errNum = Err.Number ' Save the error number that occurred. On Error GoTo 0 ' Turn error checking back on. ' Check to see which error occurred. If errNum <> 0 Then IsFileOpen = True End Function Lógicamente, si las usáis deberéis cambiar los rangos, datos, etc. en las macros por los que vosotros necesitéis. Saludos

Bienvenido a la mayor comunidad de usuarios EXCEL

Regístrate gratis ahora para ver contenidos y descargas sin restricciones!

Regístrate gratis Ingresar

JavaScript está desactivado. Para una mejor experiencia, por favor active JavaScript en su navegador antes de continuar.

Varias macros para trabajar con libros cerrados

Autor del tema Haplox
Fecha de inicio 6 Mar 2017

Haplox

Moderator

6 Mar 2017

Qué tal,

Os dejo algunas macros para trabajar con libros cerrados. Con estas macros he conseguido modificar más de 900 archivos sin tener que abrir uno por uno. Cualquier recomendación de mejora...

Para poder visualizar el resto de este tema y sus adjuntos:
. Si nunca te has registrado puedes registrarte gratis aquí
. Si ya te has registrado debes iniciar sesión aquí

Iniciar sesión o registrarme para responder aquí.

Temas similares

Pregunta

Buscador de palabra en varias hojas de un mismo libro en Macros

Respuestas: 2

12 Abr 2023

Kerthya

Pregunta

Buscador de palabra en varias hojas de un mismo libro en Macros

Respuestas: 2

12 Abr 2023

Macro Antonio

Resuelto

Unir varias macros en una sola

Respuestas: 4

26 Jul 2022

star022

Pregunta

Macros copiar varias columnas con pegado especial

Respuestas: 9

1 Dic 2021

jarja33

Pregunta

Crear Barra De Progreso A Tiempo Real De Ejecución De Varias Macros

Respuestas: 6

1 Jun 2021

Héctor Miguel

Pregunta

Llamar Varias Macros con un solo Boton.

Respuestas: 6

27 Jun 2020

Jacobo Maizo

Pregunta

Asignar formulas a varias celdas con Macros.

Respuestas: 5

27 Abr 2020

Protostecnologia

Pregunta

Ejecutar varias macros desde una hoja

Respuestas: 1

2 Abr 2018

Vico

Pregunta

ejecutar varias macros al mismo tiempo

Respuestas: 1

14 Mar 2018

Macro Antonio

Pregunta

Copiar mediante macros varias hojas a un nuevo libro con el

Respuestas: 0

23 May 2017

Tortu

Facebook X Bluesky LinkedIn Reddit Pinterest Tumblr WhatsApp Correo electrónico Enlace

Bienvenido a nuestro foro Excel 👋

Tenemos 135.000 usuarios registrados,
y 240.000 preguntas y respuestas Excel.

Primero 👉 regístrate gratis aquí 👈
para ver contenidos y descargas
sin restricciones!

Este sitio usa cookies para ayudar a personalizar el contenido, adaptar su experiencia y mantenerlo conectado si se registra.
Al continuar usando este sitio, usted está consintiendo nuestro uso de cookies.

Aceptar Saber más…

Volver

Arriba