Excel - recorrer libros abrir y copiar registros de meses

Amigos(as)
Hola, necesito su ayuda en este problema planteado. Necesito abrir libros (septiembre2010.xlsx, octubre2010.xlsx, noviembre2010.xlsx, etc.) de todos los meses del año uno a uno y copiar los registros de la hoja del mes correspondiente.Todos esos registros tienen que estar consolidado en un libro resumen.xlsm - Hoja("basedato") .
el codigo que estoy trabajando es el siguiente; estoy abriendo el libro(diciembre2010.xlsx) y copiando la hoja(diciembre), pero me falta seguir abriendo y copiando la hoja de otros libros de meses.todos estos registros lo quiero consolidar en otra hoja(basedato) de otro libro(resumen.xlsm)
Private Sub CommandButton1_Click()
dim strArchivo as string
dim oLibro As workbook
dim FilaB, FilaA, Fila As Long
dim ws as worksheet, ws1 As worksheet
dim Fila2 As Integer
dim Celdita As Range
worksheets("basedato").range("A2:AC85000").value = empty
'Creamos la variable de la ruta
strArchivo = "C:\Documents and Settings\catalina\Escritorio\año2010\diciembre2010.xlsx"
'comprobamos si el archivo existe en la ruta indicada
If dir(strArchivo) = "" then
MsgBox "No existe el archivo en la ruta indicada."
exit sub
end If
'deshabilitamos la actualizacion de pantalla
application.screenUpdating = False
'Comprobamos si el libro ya esta abierto,
'y, si no lo esta, lo abrimos
'deshabilitamos los avisos de error
on error resume next
'Intentamos asignar a la variable un libro
'abierto con el nombre que buscamos
Set oLibro = Workbooks(Dir(strArchivo))
'Habilitamos los avisos de error
On Error GoTo 0
'Si la variable no tiene nada asignado
'le asignamos el libro abriendolo directamente
If oLibro Is Nothing Then Set oLibro = workbooks.Open(strArchivo)
set ws1 = workbooks("resumen.xlsm").worksheets("basedato")
set ws = oLibro.worksheets("diciembre")
FilaB = 2
while WS.Cells(FilaB, 2).Value <> Empty
FilaB = FilaB + 1
wend
filaA = 2
for each celdita In ws.Range("B2:B" & FilaB - 1)
sem = Celdita.Offset(, -1).Value
mes = Celdita.Offset(, 0).Value
año = Celdita.Offset(, 1).Value
fechDoc = Celdita.Offset(, 2).Value
fact = Celdita.Offset(, 3).Value
ordCompra = Celdita.Offset(, 4).Value
almacen = Celdita.Offset(, 5).Value
cobro = Celdita.Offset(, 6).Value
razonsocial = Celdita.Offset(, 7).Value
sala = Celdita.Offset(, 8).Value
cliente = Celdita.Offset(, 9).Value
ordennomb = Celdita.Offset(, 10).Value
hruta = Celdita.Offset(, 11).Value
ruta = Celdita.Offset(, 12).Value
ws1.Cells(FilaA, 1).Value = Sem
ws1.Cells(FilaA, 2).Value = Mes
ws1.Cells(FilaA, 3).Value = Año
ws1.Cells(FilaA, 4).Value = FechDoc
ws1.Cells(FilaA, 5).Value = Fact
ws1.Cells(FilaA, 6).Value = OrdCompra
ws1.Cells(FilaA, 7).Value = Almacen
ws1.Cells(FilaA, 8).Value = Cobro
ws1.Cells(FilaA, 9).Value = RazonSocial
ws1.Cells(FilaA, 10).Value = Sala
ws1.Cells(FilaA, 11).Value = Cliente
ws1.Cells(FilaA, 12).Value = OrdenNomb
ws1.Cells(FilaA, 13).Value = HRuta
ws1.Cells(FilaA, 14).Value = Ruta
FilaA = FilaA + 1
Next
'Cerramos sin guardar cambios
oLibro.Close False
'Vaciamos la variable
Set oLibro = Nothing
'Habilitamos la actualizacion de pantalla
Application.ScreenUpdating = True
End Sub

Gracias

Atte.

Catita

Para integrar varios libros en uno solo poniendo todos las hojas en una sola crearia una tabla con los nombres de los meses.

Macro:

Abrir Libro Destino
FOR del 1 al 12 (para cada mes)
NEXT
Cerrar Libro Destino


Nota: Creo que la copia se puede hacer mucho más simple pero no conozco ni los datos ni la estructura de la hoja.

hice una adaptación 'liviana' de tu código...

Private Sub CommandButton1_Click()
Dim MiRuta As String
Dim arcact As String
Dim arch As String

Dim wbSrc As Workbook, wsSrc As Worksheet
Dim wbDst As Workbook, wsDst As Worksheet, rngSrc As Range
Dim lOff&

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
MiRuta = ActiveWorkbook.Path
arcact = ActiveWorkbook.Name

arch = Dir(MiRuta & "\*.xlsx")

Set wbDst = ActiveWorkbook
Set wsDst = wbDst.Sheets("basedato")
lOff = 0

wsDst.Cells.Clear

Do Until arch = ""
If arch <> arcact Then
Set wbSrc = Workbooks.Open(Filename:=MiRuta & "\" & arch)
Set wsSrc = ActiveSheet '//Suponiendo que es la hoja que se desea copiar...
Set rngSrc = wsSrc.UsedRange '//Copiar todo...
rngSrc.Copy Destination:=wsDst.Range("A1").Offset(lOff) '//Copiar debajo de lo anterior...
lOff = lOff + rngSrc.Rows.Count + 1
wbSrc.Close False
End If
arch = Dir
Loop

Application.DisplayAlerts = True
Application.ScreenUpdating = True
'Application.Calculation = xlCalculationAutomatic '//En modo automático no terminan más los cálculos!!!
End Sub

Saludos, desde Baires, JuanC

Antoni,

La tabla donde la crearia...?, ademas no quiero cerrar el libro destino libro("resumen") hoja("basedato") , solo quiero abrir y cerrar uno a uno los libros origenes
A continuacion detallo los datos y la estructura.

Libros origenes

LIbro(enero2010) Hoja("enero")
A---------B------------C-------------D-----------------E-----------F-----------G--------H
Nª----nombre----articulo---descripcion----direccion---cliente---precio--destino
7------pghm----- 23785--------leche----------callao-----luchent----2344---concepcion
7------prbkm----- 2905--------torta------------centro-----marchet---345----santiago
7------przxm----- 2565---------yocurht--------casma-----lucars-----3266---concon
7------prrqw----- 2675---------caram----------callao-----luctrst-----3114---conce

Y los otros libros origenes(meses restantes) tienen la misma estructura de datos

Libro destino
Libro("resumen")Hoja("basedato")
A---------B------------C-------------D-----------------E-----------F-----------G--------H
Nª----nombre----articulo---descripcion----direccion---cliente---precio--destino

En este Libro destino, en la Hoja("resumen") se deben de pegar todos los libros origenes uno a continuacion de otro.

Atte.

Catita

Quiero agregar que en realidad la hoja de los libros origenes tienen 28 columnas y 10000 filas aproximadamente cada uno para pegar en la Hoja("basedato") del Libro destino.

Catita