Copiar misma celda de varios archivos a un nuevo libro
Tengo muchos libros con una sola hoja con el mismo formato, necesito hacer un resumen, por lo que necesito poner el valor de alrededor de 5 celdas de los libros en una tabla y que me las vaya poniendo una debajo de otra. Es decir por ejemplo necesito el valor de la celda C25, C15, D20, D10, E30 de todos los libros y colocarlos en columnas iniciando en la fila 10 de ahí hacia abajo, los valores de la celda c25 de los libros en la columna D, los de la C15 en la F y así sucesivamente.
1 respuesta
H o l a:
Te anexo la macro.
Pon la macro en un nuevo libro. Guarda el libro como excel habilitado para macros, y ponlo en cualquier carpeta diferente a la carpeta donde tienes todos tus archivos.
Ejecuta la macro, selecciona la carpeta donde tienes los archivos.
La macro pondrá las celdas en tu nuevo libro.
Sub CopiarCeldas()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets(1)
ruta = "C:\Trabajo\"
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
archi = Dir(cp & "*.xls*")
Do While archi <> ""
Set l2 = Workbooks.Open(cp & archi)
Set h2 = l2.Sheets(1)
u = h1.Range("D" & Rows.Count).End(xlUp).Row + 1
If u < 10 Then u = 10
'
h1.Cells(u, "D") = h2.[C25]
h1.Cells(u, "F") = h2.[C15]
h1.Cells(u, "H") = h2.[D20]
h1.Cells(u, "J") = h2.[D10]
h1.Cells(u, "L") = h2.[E30]
l2.Close False
archi = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Celdas copiadas", vbInformation, "COPIAR CELDAS"
End Sub