Macro para usar datos de libros
Quería consultar sobre dos formas de trabajar con libros, necesito tomar datos de una serie de libros, los nombres de estos cambian semana a semana pero el formato interno siempre es el mismo por lo que había pensado dos opciones:
Tomar datos de los libros abiertos, habría que tomar en cuenta que el libro que tomaría los datos de los otros también es un libro abierto.
Tomar datos de libros cerrados ubicados en una carpeta.
En ambas condiciones no se los nombres de estos libros, en la primera se que esta abierto y que no es en el que quiero pegar los datos y en el segundo caso se donde están y que son todos.
Mi pregunta es como programo una macro para que en ambos casos por ejemplo tome el dato de la hoja1 celda (1,1) ya sea para los abiertos exceptuando el de trabajo o para los que están en c:/trabajo.
1 Respuesta
Te anexo la macro con lo que necesitas
Instrucciones para ejecutar macro
1. Abre tu hoja de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona ALt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Para ejecutarla presiona F5
Sub busca()'Lee archivos cerrados de una carpeta'Lee archivos abiertos'en ambos casos obtiene de la primera hoja el dato de la celda A1'Por.Dam 'especificar los datos de donde se van a tomar los datosruta = "c:\trabajo\"hoja = 1 'Número de hoja, 1 para la primera, 2 para la segunda hojaref = "A1" 'Especificar el lugar donde van a quedar los datosRange("A:A").ClearRange("A1").Select Call cerrados(ruta, hoja, ref)Call abiertos(hoja, ref) End SubFunction trae(ruta, archivo, hoja, ref)'Extrae el valor de una celda de un archivo cerrado'Por.HM Dim Cnn As Object, Rec As Object Set Cnn = CreateObject("adodb.connection") Set Rec = CreateObject("adodb.recordset") Cnn.Open "provider=microsoft.jet.oledb.4.0;data source=" & _ ruta & IIf(Right(ruta, 1) <> "\", "\", "") & archivo & _ ";extended properties=""excel 8.0;hdr=no""" 'Rec.Open "select * from [" & hoja & "$" & Range(ref).Resize(2, 1).Address(0, 0) & "]", Cnn, 1, 1 Rec.Open "select * from [" & Sheets(hoja).Range(ref).Resize(2, 1).Address(0, 0) & "]", Cnn, 1, 1 trae = Rec(0).Value Rec.Close: Set Rec = Nothing Cnn.Close: Set Cnn = NothingEnd FunctionSub abiertos(hoja, ref)'lee archivos abiertos'Por.Dammilibro = ThisWorkbook.Namelabiertos = Workbooks.CountFor i = 1 To labiertosSelect Case Workbooks(i).Name Case milibro Case Else ActiveCell.Value = Workbooks(i).Worksheets(hoja).Range(ref) ActiveCell.Offset(1, 0).SelectEnd SelectNext End SubSub cerrados(ruta, hoja, ref)'Lee archivos del directorio'Por.DamChDir rutaarchi = Dir("*.xls") Do While archi <> "" ActiveCell.Value = trae(ruta, archi, hoja, ref) ActiveCell.Offset(1, 0).Select archi = Dir()LoopEnd Sub
Saludos. Dam
