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

1 Respuesta

Respuesta
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
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
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.

Añade tu respuesta

Haz clic para o