Consolidar rangos de varios archivos.

14/07/2004 - 11:29 por MarianoH | Informe spam
Tengo un archivo del cual creo una copia cada día, a fin de mes necesito un
rango en particular (Llamda "Datos") de cada día, todos en un nuevo archivo,
o sea, copiar en un nuevo archivo los rangos correspondientes a cada día uno
abajo del otro, para luego consolidar los datos.
Los archivos están todos en una carpeta y se llaman "Archivo de proceso
xx-xx" donde xx-xx es la fecha (por ej. 13-07).
¿Como puede llegar a ser una rutina VBA para obtener este rango archivo por
archivo?

Saludos y gracias
 

Leer las respuestas

#1 Fernando Arroyo
14/07/2004 - 14:29 | Informe spam
Prueba con el siguiente código, teniendo en cuenta que:
- es necesario establecer una referencia a la biblioteca "Microsoft ActiveX Data Objects X.x Library", donde X.x es la versión más alta que tengas. Esto se hace (estando en el editor de VBA) desde Herramientas->Referencias
- la carpeta donde están los libros tienes que especificarla en la instrucción .LookIn = ""
- el mes a procesar lo determina el patrón indicado en la instrucción .Filename = "" (tal como va el código, el mes sería el 07)
- la hoja donde se volcarán los datos es Hoja1 del libro en que esté situado el código


Sub Consolidar()
Dim fsB As FileSearch
Dim n As Long

Dim rsR As ADODB.Recordset
Dim cnC As ADODB.Connection
Dim strC As String
Dim strSQL As String

Set fsB = Application.FileSearch

Application.ScreenUpdating=False

With fsB

.NewSearch
.LookIn = "C:\prueba" 'Directorio donde están los ficheros
.Filename = "07.xls" 'Patrón

If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
For n = 1 To fsB.FoundFiles.Count
strC = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & fsB.FoundFiles(n) & ";" & _
"Extended Properties=""Excel 8.0;HDR=No"";"
strSQL = "SELECT * FROM [Datos]"
Set rsR = New ADODB.Recordset
rsR.Open strSQL, strC, adOpenForwardOnly, adLockReadOnly, adCmdText
Worksheets("Hoja1").Range("A" & [Hoja1!A65536].End(xlUp).Row + 1).CopyFromRecordset rsR
Next n
End If

End With

Application.ScreenUpdating = True

Set rsR = Nothing
Set cnC = Nothing
Set fsB = Nothing
End Sub


Un saludo.


Fernando Arroyo
MS MVP - Excel


"MarianoH" escribió en el mensaje news:
Tengo un archivo del cual creo una copia cada día, a fin de mes necesito un
rango en particular (Llamda "Datos") de cada día, todos en un nuevo archivo,
o sea, copiar en un nuevo archivo los rangos correspondientes a cada día uno
abajo del otro, para luego consolidar los datos.
Los archivos están todos en una carpeta y se llaman "Archivo de proceso
xx-xx" donde xx-xx es la fecha (por ej. 13-07).
¿Como puede llegar a ser una rutina VBA para obtener este rango archivo por
archivo?

Saludos y gracias


Preguntas similares