Consolidar rangos de varios archivos.

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

Muchas gracias Fernando el código es óptimo y para colmo funciona
extremadamente rápido.

Consulta: ¿Alguien sabe de donde puede sacar información sobre el uso de ADO
en Excel?

Otra vez gracias.
Mariano

"Fernando Arroyo" escribió en el mensaje
news:
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

"MarianoH" escribió en el mensaje news:

Muchas gracias Fernando el código es óptimo y para colmo funciona
extremadamente rápido.

:-))

Consulta: ¿Alguien sabe de donde puede sacar información sobre el uso de ADO
en Excel?

Hombre, hay un "clásico" escrito por Enrique Martínez, MVP de Visual Basic:

http://www.mvp-access.com/softjaen/..._excel.htm

Un saludo.


Fernando Arroyo
MS MVP - Excel

Otra vez gracias.
Mariano