Macro para Extraer datos de varios libros con nombres consecutivos
Hola, es mi primera vez en el foro.
Tengo varios libros (cada uno es una factura individual) y quisiera extraer automativamente de cada libro los montos y productos (que están en lugares fijos), y pegar esos datos consecutivamente en otro libro para que sea mi resumen de ventas, ¿hay alguna macro que me permita eso?
Los libros tienen nombres consecutivos.
Gracias
1 Respuesta
En realidad hay que hacer la macro a la medida de lo que necesitas.
Para ello necesito que me envíes un par de libros: "libro1" con los montos y productos que van a ser extraídos (me indicas con colores o con comentarios cuáles serán esos datos). El segundo libro, es el libro "resumen". En este libro "resumen" me pones los datos que extrajiste del "libro1".
¿También me tienes que decir cuáles libros serán procesados o serán todos los libros que se encuentren en una carpeta?
Gracias Dante!! ahí te estoy pasando por mail lo que me pediste.
Abrazo!!
Te envié el archivo con la macro.
Esta es la macro
Sub contable()
'Por.DAM
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
u = h1.Range("B" & Rows.Count).End(xlUp).Row
If u < 6 Then u = 6
ruta = l1.Path
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Selecciona una carpeta"
.AllowMultiSelect = False
.InitialFileName = ruta
If .Show <> -1 Then Exit Sub
cp = .SelectedItems(1)
End With
h1.Range("A6:L" & u).ClearContents
ChDir cp
archi = Dir("*Factura.xls*")
f = 6
Do While archi <> ""
Workbooks.Open archi
Set l2 = ActiveWorkbook
Set h2 = l2.ActiveSheet
For i = 13 To 32
If h2.Cells(i, "A") = "" Or Left(h2.Cells(i, "A"), 4) = "Prod" Then Exit For
h1.Cells(f, "A") = h2.Cells(3, "G")
h1.Cells(f, "B") = h2.Cells(i, "C")
h1.Cells(f, "C") = h2.Cells(i, "A")
h1.Cells(f, "D") = h2.Cells(i, "B")
h1.Cells(f, "E") = h2.Cells(2, "G")
h1.Cells(f, "F") = h2.Cells(i, "G")
h1.Cells(f, "G") = h2.Cells(i, "P")
h1.Cells(f, "H") = h1.Cells(f, "F") - h1.Cells(f, "G")
h1.Cells(f, "J") = h1.Cells(f - 1, "J") + h1.Cells(f, "F") - h1.Cells(f, "I")
h1.Cells(f, "K") = h1.Cells(f - 1, "K") + h1.Cells(f, "H")
h1.Cells(f, "L") = h1.Cells(f - 1, "L") + h1.Cells(f, "G")
f = f + 1
Next
l2.Close False
archi = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Se actualizaron los registros", vbInformation, "CONTABLE"
End Sub
¡Gracias!
Funciona a la perfección, invalorble aporte que me ahorra mucho trabajo y esfuerzo.
Da gusto encontrar personas así.
Súper atento, altruista y la respuesta llegó más que rápido.
Muchas gracias nuevamente, un abrazo cordial a la distancia.
