Macro para copiar un rango de celdas de un libro o varios a otro
Tengo una macro que copia el contenido de cada fichero el contenido de la hoja 1 que hay en un directorio y lo pega en un archivo llamado nuevo:
Sub libro()
Application.ScreenUpdating = False
ruta = ThisWorkbook.Path
ChDir ruta
archi = Dir("*.xls*")
Set h1 = ThisWorkbook.Sheets("hoja1")
On Error Resume Next
Do While archi <> ""
If InStr(1, archi, "nuevo") = 0 Then
Workbooks.Open archi
If Err.Number = 0 Then
Sheets(1).Select
Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Copy _
h1.Range("A" & h1.Range("A1").SpecialCells(xlLastCell).Row + 1)
Else
Err.Number = 0
End If
Application.DisplayAlerts = False
Workbooks(archi).Close
Application.DisplayAlerts = True
End If
archi = Dir()
Loop
End Sub
Necesitaría que en vez de pegar el contenido completo de cada "hoja 1" de cada fichero, copie, de cada fichero ubicado en el directorio, de una pestaña llamada "RESUMEN" las celdas A2, D2, E2, I2, L2 y las pegue como valores en el fichero "nuevo", en una pestaña llamada "BBDD".
2 respuestas
H o l a:
Pon la siguiente macro en tu libro de macros. Deberás tener abierto tu libro "nuevo.xlsx".
Sub libro()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set l2 = Workbooks("nuevo.xlsx")
Set h2 = l2.Sheets("BBDD")
f = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
'
ruta = l1.Path
'ruta = "C:\trabajo\"
ChDir ruta
archi = Dir("*.xls*")
On Error Resume Next
'
Do While archi <> ""
If InStr(1, archi, "nuevo") = 0 Then
Set l3 = Workbooks.Open(archi)
If Err.Number = 0 Then
Set h3 = l3.Sheets("RESUMEN")
If Err.Number = 0 Then
h3.Range("A2, D2, E2, I2, L2").Copy
h2.Range("A" & f).PasteSpecial xlValues
f = f + 1
Else
Err.Number = 0
End If
Else
Err.Number = 0
End If
l3.Close
End If
archi = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Terminado"
End Sub‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
Este ejemplo, hace lo que requieres con hojas del mismo libro
http://www.programarexcel.com/2014/01/recorre-hojas-extrae-datos-para-resumen.html
Este libro hace un resumen de hojas de otros libros.
http://www.programarexcel.com/2014/02/abre-libros-extrae-informacion-y-hace.html
acá mas ejemplos