Copiar información de distintos libros en uno solo
Hola,
Mi problema es que tengo 365 archivos que contienen información y quisiera agrupar toda esta información en una solo a hoja de excel. Todos los archivos están en un mismo directorio, tienen nombres que van en secuencia 0101,0102,0103... Siendo los dos primeros dígitos los días del mes (que llegarían hasta 31) y los dos últimos dígitos los meses del año (que llegarían hasta 12)... O sea que contaríamos con 0101, 0102, 0103, 0104, 0105, 0106, 0107, 0108, 0109, 0110, 0111, 0112. Y así hasta llegar hasta el 3112.
Lo que quiero es realizar una Macro, que abra cada uno de los libros y me copie la información de la "Hoja1" y la vaya pegando una debajo de la otra en un solo archivo.
La información que contienen los archivos es parecida... Es un histórico que realiza una maquina que me da la información diaria cada 15 minutos... Entonces va haciendo un historia diario.
Soy usuario novato en estos de macros y buscando en internet encuentro varias macros que hacen cosas parecidas, pero para recortar y pegar en una sola macro ya no sirvo...
Espero que me puedas ayudar.
Mi problema es que tengo 365 archivos que contienen información y quisiera agrupar toda esta información en una solo a hoja de excel. Todos los archivos están en un mismo directorio, tienen nombres que van en secuencia 0101,0102,0103... Siendo los dos primeros dígitos los días del mes (que llegarían hasta 31) y los dos últimos dígitos los meses del año (que llegarían hasta 12)... O sea que contaríamos con 0101, 0102, 0103, 0104, 0105, 0106, 0107, 0108, 0109, 0110, 0111, 0112. Y así hasta llegar hasta el 3112.
Lo que quiero es realizar una Macro, que abra cada uno de los libros y me copie la información de la "Hoja1" y la vaya pegando una debajo de la otra en un solo archivo.
La información que contienen los archivos es parecida... Es un histórico que realiza una maquina que me da la información diaria cada 15 minutos... Entonces va haciendo un historia diario.
Soy usuario novato en estos de macros y buscando en internet encuentro varias macros que hacen cosas parecidas, pero para recortar y pegar en una sola macro ya no sirvo...
Espero que me puedas ayudar.
1 Respuesta
Respuesta de Edwin Rebolledo
1
Aquí tienes un ejemplo de como puedes realizar la tarea:
Sub Cop()
Dim DIA, MES, FILA As Integer
On Error GoTo exit_error
' AQUI COLOCAS EL DIRECTORIO DE TU ARCHIVO DONDE SE CONSOLIDARA LA INFORMACION
ChDir "C:\MMMMM"
Workbooks.Open Filename:="C:\MMMMM\Matriz.xls"
For DIA = 1 To 31
MES = 1
Workbooks.Open Filename:="C:\MMMMM\" & "0" & DIA & "0" & MES & ".xls" ' AQUI ABRO EL ARCHIVO CON NOMBRE 0101.xls
Windows("0" & DIA & "0" & MES).Activate
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection. Copy ' esta linea copia los valores del archivo 0101.xls para pegarlos en la matriz
Windows("Matriz").Activate
For FILA = 1 To 300
Range("A" & FILA).Select
If Selection = "" Then ' aqui validamos filas en blanco para pegar la informacion de manera que quede una bajo la otra
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
FILA = 300
Else
End If
Next FILA
Windows("0" & DIA & "0" & MES).Activate
Application.CutCopyMode = False
ActiveWindow.Close ' aqui cerramos el archivo 0101.xls para pasar al siguiente
Next
exit_error:
MsgBox "ERROR ENCONTRADO!", vbCritical, "ERROR"
Exit Sub
End Sub
Sub Cop()
Dim DIA, MES, FILA As Integer
On Error GoTo exit_error
' AQUI COLOCAS EL DIRECTORIO DE TU ARCHIVO DONDE SE CONSOLIDARA LA INFORMACION
ChDir "C:\MMMMM"
Workbooks.Open Filename:="C:\MMMMM\Matriz.xls"
For DIA = 1 To 31
MES = 1
Workbooks.Open Filename:="C:\MMMMM\" & "0" & DIA & "0" & MES & ".xls" ' AQUI ABRO EL ARCHIVO CON NOMBRE 0101.xls
Windows("0" & DIA & "0" & MES).Activate
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection. Copy ' esta linea copia los valores del archivo 0101.xls para pegarlos en la matriz
Windows("Matriz").Activate
For FILA = 1 To 300
Range("A" & FILA).Select
If Selection = "" Then ' aqui validamos filas en blanco para pegar la informacion de manera que quede una bajo la otra
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
FILA = 300
Else
End If
Next FILA
Windows("0" & DIA & "0" & MES).Activate
Application.CutCopyMode = False
ActiveWindow.Close ' aqui cerramos el archivo 0101.xls para pasar al siguiente
Next
exit_error:
MsgBox "ERROR ENCONTRADO!", vbCritical, "ERROR"
Exit Sub
End Sub
