Ejecutar macro en varios archivos
Tengo que ejecutar la siguiente macro en varios archivos de diferente directorio, como la modifico para que lo realice sin tener que ejecutarla archivo por archivo. Aclaro que voy a copiar em mismo rango de datos de los diferentes archivos en uno solo que se llama mensuales, pero en diferente hoja.
Sub Macro2()
'
' Macro2 Macro
' Macro grabada el por pelolasanide
Workbooks.Open Filename:="J:\Mensuales.xls"
Sheets.Add
Sheets("Hoja1").Name = "12167"
Range("A1").Select
ActiveWindow.Zoom = 75
ChDir "J:\EST12167"
Workbooks.Open Filename:="J:\EST12167\EST12167_Llena.xls"
Sheets("Precipitación").Select
Range("AI1:AO554").Select
Selection.Copy
Windows("Mensuales.xls").Activate
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3:J554").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00"
Range("A1").Select
Windows("EST12167_Llena.xls").Activate
Range("A2:B554").Select
Selection.Copy
Windows("Mensuales.xls").Activate
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").Select
ActiveCell.FormulaR1C1 = "Estacion"
Range("A3").Select
ActiveCell.FormulaR1C1 = "12167"
Selection.AutoFill Destination:=Range("A3:A554")
Range("A3:A554").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "Precipitacion"
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
ActiveWorkbook. Sabe
ActiveWorkbook. Close
End Sub
Sub Macro2()
'
' Macro2 Macro
' Macro grabada el por pelolasanide
Workbooks.Open Filename:="J:\Mensuales.xls"
Sheets.Add
Sheets("Hoja1").Name = "12167"
Range("A1").Select
ActiveWindow.Zoom = 75
ChDir "J:\EST12167"
Workbooks.Open Filename:="J:\EST12167\EST12167_Llena.xls"
Sheets("Precipitación").Select
Range("AI1:AO554").Select
Selection.Copy
Windows("Mensuales.xls").Activate
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3:J554").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00"
Range("A1").Select
Windows("EST12167_Llena.xls").Activate
Range("A2:B554").Select
Selection.Copy
Windows("Mensuales.xls").Activate
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").Select
ActiveCell.FormulaR1C1 = "Estacion"
Range("A3").Select
ActiveCell.FormulaR1C1 = "12167"
Selection.AutoFill Destination:=Range("A3:A554")
Range("A3:A554").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "Precipitacion"
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
ActiveWorkbook. Sabe
ActiveWorkbook. Close
End Sub
1 Respuesta
Respuesta de paramisolo
1
Siento decirte que por lo que veo en la macro va a ser imposible modificarla de forma que ni excel ni VBA son "magos" para saber por ellos mismos:
1º Que libro quieres abrir
2º De que directorio
3º Que le vas a añadir una hoja con un nombre específico
Todo lo demás sí se puede hacer repetitivo, sería posible si el directorio fuese el mismo y solo estuviesen los archivos que tienes que ir abriendo, porque podemos hacer una macro que repase todo un directorio y en función a la lista creada que vaya abriendo uno a uno, crees la hoja con el nombre fijo o el que tenga en alguna celda, y que lo guarde en ese mismo directorio, pisando el anterior o con un nombre nuevo, o en otro directorio pero que sea fijo para poderlo escribir en la macro.
Razona lo que te he dicho a ver como sacamos el nombre del libro y de que directorio si esto va variando a tu necesidad.
Piensaló y me cuentas.
>Un saludo
>Julio
1º Que libro quieres abrir
2º De que directorio
3º Que le vas a añadir una hoja con un nombre específico
Todo lo demás sí se puede hacer repetitivo, sería posible si el directorio fuese el mismo y solo estuviesen los archivos que tienes que ir abriendo, porque podemos hacer una macro que repase todo un directorio y en función a la lista creada que vaya abriendo uno a uno, crees la hoja con el nombre fijo o el que tenga en alguna celda, y que lo guarde en ese mismo directorio, pisando el anterior o con un nombre nuevo, o en otro directorio pero que sea fijo para poderlo escribir en la macro.
Razona lo que te he dicho a ver como sacamos el nombre del libro y de que directorio si esto va variando a tu necesidad.
Piensaló y me cuentas.
>Un saludo
>Julio
Ok, entiendo; suponiendo que todos mis archivos están en el mismo directorio, con cualquier ruta (por ejemplo c:\estaciones\) ¿Qué tendría que modificar? O para ser más especifico que tengo que modificar de mis archivos (directorio, nombre, ruta, etc) para poder ejecutar lo que me explicaste anteriormente. En ese sentido no hay problema si los pongo en el mismo directorio y en cuanto al nombre de la hoja se puede quedar como la da excel automáticamente al generarla.
Saludos
Saludos
Vamos a ver si me explico y tu me entiendes, lo primero abrimos tu Libro Mensuales.xls
Y en una hoja vacía vamos a extraer de un directorio en tu caso J:\EST12167 (donde tendrías todos los archivos juntos desde los que vas a copiar un rango y lo vas a llevar a tu Libro Mensuales.xls) todos los archivos .xls que contiene y te pondrá el nombre en esa hoja esto lo hacemos con esta macro que debes de poner en un modulo, si aumenta el numero de archivos borras los datos de esa hoja y ejecutas la macro te volverá a llevar el nombre de todos los archivos que hay en ese directorio:
Sub RepasarCarpeta()
'Sacamos los nombres de los archivos de la carpeta.
Dim strArchivoExcel As String
Dim strNombreCarpeta As String
Dim r As Range
Sheets("Hoja3").Select
Range("A1").Select
'carpeta a repasar
strNombreCarpeta = "J:\EST12167"
'preparar carpeta
ChDir strNombreCarpeta
strArchivoExcel = Dir("*.xls")
'repasamos los archivos de la carpeta
Do While strArchivoExcel <> ""
strArchivoExcel = Dir
Set r = ActiveCell
r.Value = strArchivoExcel
r.Offset(1, 0).Activate
Loop
End Sub
Ya tenemos todos los archivos que contiene la carpeta ahora tenemos que modificar tu macro para que desde esa hoja tome el nombre de cada archivo, lo abra desde el directorio donde están y copie el rango que tu quieras y lo pegue en la hoja y rango que tu elijas de tu libro Mensuales.
Sub Macro2()
'
' Macro2 Macro
' Macro grabada el por pelolasanid
Sheets("Hoja3").Select
Range("A1").Select
archivo=ActiveCell.Value
ChDir "J:\EST12167"
Workbooks.Open Filename:=archivo
Sheets("Precipitación").Select
Range("AI1:AO554").Select
Selection.Copy
Windows("Mensuales.xls").Activate
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3:J554").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00"
Range("A1").Select
Windows("archivo").Activate
Range("A2:B554").Select
Selection.Copy
Windows("Mensuales.xls").Activate
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").Select
ActiveCell.FormulaR1C1 = "Estacion"
Range("A3").Select
ActiveCell.FormulaR1C1 = "12167"
Selection.AutoFill Destination:=Range("A3:A554")
Range("A3:A554").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "Precipitacion"
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
ActiveWorkbook. Sabe
Windows("archivo"). Activate
ActiveWorkbook. Close
End Sub
Esto te vale para el primer archivo del directorio de la hoja3 para repasar todos los archivos debes de crear un ciclo Do While Loop para que vaya abriendo todos los libros y te vaya copiando el rango deseado a tulibro Mensuales, tan solo debes de cambiar el rango de pegado porque sino unos datos pisaran a los otros, debes de indicarle que en vez en rango fijo que se sitúe en el primer dato y baje hasta la primera fila vacía para pegar los siguientes datos de los otros libros. De esta forma tu Libro Mensuales.xls sera un resumen de todos los Libros de ese directorio.
>Un saludo
>Julio
PD: Si necesitas alguna aclaración me lo dices, si te ha servido puntúa la consulta y la finalizas, un comentario siempre es bienvenido.
Y en una hoja vacía vamos a extraer de un directorio en tu caso J:\EST12167 (donde tendrías todos los archivos juntos desde los que vas a copiar un rango y lo vas a llevar a tu Libro Mensuales.xls) todos los archivos .xls que contiene y te pondrá el nombre en esa hoja esto lo hacemos con esta macro que debes de poner en un modulo, si aumenta el numero de archivos borras los datos de esa hoja y ejecutas la macro te volverá a llevar el nombre de todos los archivos que hay en ese directorio:
Sub RepasarCarpeta()
'Sacamos los nombres de los archivos de la carpeta.
Dim strArchivoExcel As String
Dim strNombreCarpeta As String
Dim r As Range
Sheets("Hoja3").Select
Range("A1").Select
'carpeta a repasar
strNombreCarpeta = "J:\EST12167"
'preparar carpeta
ChDir strNombreCarpeta
strArchivoExcel = Dir("*.xls")
'repasamos los archivos de la carpeta
Do While strArchivoExcel <> ""
strArchivoExcel = Dir
Set r = ActiveCell
r.Value = strArchivoExcel
r.Offset(1, 0).Activate
Loop
End Sub
Ya tenemos todos los archivos que contiene la carpeta ahora tenemos que modificar tu macro para que desde esa hoja tome el nombre de cada archivo, lo abra desde el directorio donde están y copie el rango que tu quieras y lo pegue en la hoja y rango que tu elijas de tu libro Mensuales.
Sub Macro2()
'
' Macro2 Macro
' Macro grabada el por pelolasanid
Sheets("Hoja3").Select
Range("A1").Select
archivo=ActiveCell.Value
ChDir "J:\EST12167"
Workbooks.Open Filename:=archivo
Sheets("Precipitación").Select
Range("AI1:AO554").Select
Selection.Copy
Windows("Mensuales.xls").Activate
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E3:J554").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00"
Range("A1").Select
Windows("archivo").Activate
Range("A2:B554").Select
Selection.Copy
Windows("Mensuales.xls").Activate
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A2").Select
ActiveCell.FormulaR1C1 = "Estacion"
Range("A3").Select
ActiveCell.FormulaR1C1 = "12167"
Selection.AutoFill Destination:=Range("A3:A554")
Range("A3:A554").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "Precipitacion"
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1").Select
ActiveWorkbook. Sabe
Windows("archivo"). Activate
ActiveWorkbook. Close
End Sub
Esto te vale para el primer archivo del directorio de la hoja3 para repasar todos los archivos debes de crear un ciclo Do While Loop para que vaya abriendo todos los libros y te vaya copiando el rango deseado a tulibro Mensuales, tan solo debes de cambiar el rango de pegado porque sino unos datos pisaran a los otros, debes de indicarle que en vez en rango fijo que se sitúe en el primer dato y baje hasta la primera fila vacía para pegar los siguientes datos de los otros libros. De esta forma tu Libro Mensuales.xls sera un resumen de todos los Libros de ese directorio.
>Un saludo
>Julio
PD: Si necesitas alguna aclaración me lo dices, si te ha servido puntúa la consulta y la finalizas, un comentario siempre es bienvenido.
