Macro Excel abrir, copiar, pegar, cerrar y repetir hasta final
Quiero tener una macro que me permita abrir una serie de archivos excel y copiar las celdas de su interior, en concreto:
- C10
- G10
- C11
Y luego de B16 a H16.
Si las celdas inferiores B17 a H17 tienen contenido también... Así hasta B29 o que no haya contenido.
Luego copiar B32.
Se pegarían en un libro distinto en una línea (por ejemplo en B2) las celdas de forma consecutiva (C10, G10, C11, B16 a H16 y B32), luego en la siguiente si hay contenido en B17, se copiaría en b3 (C10, G10, C11, B17 a H17 y B32)... Cuando no haya más datos, cerrar libro y abrir siguiente.
¿Esto es posible?
1 respuesta
Te anexo la macro.
Cambia en la macro: "C:\trabajo\archivos\" por el nombre de la carpeta donde tienes los archivos.
Pon el libro con la macro en una carpeta diferente a donde tienes los archivos.
La macro copiará las celdas de cada libro de la primera hoja. Y pegará los datos en el libro que contiene la macro en la primera hoja.
Sub Copiar_Pegar_Cerra_Repetir()
'Por Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets(1)
'
h1.Rows("2:" & Rows.Count).Clear
'
fila = 2
ruta = "C:\trabajo\archivos\"
arch = Dir(ruta & "*.xls*")
Do While arch <> ""
Set l2 = Workbooks.Open(ruta & arch)
Set h2 = l2.Sheets(1)
h1.Cells(fila, "B") = h2.Range("C10")
h1.Cells(fila, "C") = h2.Range("G10")
h1.Cells(fila, "D") = h2.Range("C11")
i = 16
Do While h2.Cells(i, "B").Value <> ""
h1.Cells(fila, "B").Value = h2.Range("C10").Value
h1.Cells(fila, "C").Value = h2.Range("G10").Value
h1.Cells(fila, "D").Value = h2.Range("C11").Value
H1. Range(h1. Cells(fila, "E"), h1. Cells(fila, "K")).Value = h2. Range(h2.Cells(i, "B"), h2.Cells(i, "H")).Value
h1.Cells(fila, "L").Value = h2.Range("C32").Value
fila = fila + 1
i = i + 1
If i = 30 Then Exit Do
Loop
l2.Close False
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub.
.Sal u dos. Dante Amor. No olvides valorar la respuesta. G raci as
.
