Foro Excel

Un grato saludo a todos los noveles, intermedios, avanzados, expertos y doctos que visitan este foro de Excel. La colaboración que pido la dirijo a cualquier persona en el foro que pueda resolverla. Hace un tiempo un compañero me ayudó a desarrollar una pequeña macro que transfiere información a través de un Userform de Excel a campos de Acces sin tener que hacer la apertura de éste (Dejo el archivo para quien lo quiera, la base Agenda.mdb, deberá copiarse a C: para que funcione). Lo que necesito es una macro que me permita transferir información de un archivo de Excel a otro archivo diferente de Excel de igual manera que el ejemplo que dejo.

Para explicarlo mejor, tengo un archivo Excel que se llama Ventas y la fecha del dí­a, este archivo tiene 2 hojas, de las cuales quiero copiar los rangos (“A1:A10â€

Segun entiendo esta es la tarea:

" Lo que necesito es una macro que me permita transferir información de un archivo de Excel a otro archivo diferente de Excel de igual manera que el ejemplo que dejo. "
" tengo un archivo Excel que se llama Ventas y la fecha del dí­a, este archivo tiene 2 hojas, de las cuales quiero copiar los rangos (“A1:A10â€

si lo quieres abrir por fecha:


Sub Abrirporfecha()
Dim dia, mes, año, sruta, obook
dia = Mid(Date, 1, 2)
mes = Mid(Date, 4, 2)
año = Mid(Date, 9, 4)
sruta = ThisWorkbook.Path
obook = "ventas" + dia + mes + año + ".xls"
ChDir sruta
If Dir(obook) = "" Then MsgBox "archivo no existe": Exit Sub
Workbooks.Open obook
End Sub

Sub Abrirporfecha()
Dim dia, mes, año, sruta, oBook
dia = Mid(Date, 1, 2): mes = Mid(Date, 4, 2): año = Mid(Date, 9, 4)
mio = ThisWorkbook.Name
sruta = ThisWorkbook.Path: oBook = "ventas" + dia + mes + año + ".xls"
ChDir sruta
If Dir(oBook) = "" Then MsgBox "archivo no existe": Exit Sub
Workbooks.Open oBook
Workbooks(oBook).Sheets("ventas").Select
Range("a1", "a10").Select
Selection.Copy
Workbooks(mio).Activate
Sheets(1).Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks(oBook).Activate
Sheets("compras").Select
Range("b5", "b11").Select
Selection.Copy
ActiveWorkbook.Close
Workbooks(mio).Activate
Sheets(1).Select
Range("b5").Select
ActiveSheet.Paste
End Sub

Solo ten cuidado con los nombres de archivo ya que se puede perder la referencia por como son creados aun y cuando a simple vista se puede ver que exista y el programa marque que no.
Esta rutina trabaja pensando que los archivos estan dentro del mismo directorio de trabajo asumiendo la estructura del nombre como ventas + dia + mes + año

Modificalo segun tus necesidades

Saludos

DISCULPA LA TARDANZA PARA AGRADECERTE LA INFORMACí“N, APENAS INGRESí‰ EL Dí