Copiar rangos de celdas de archivos de una carpeta
Para Dante Amor,
Tengo un archivo llamado OverworkMaster y necesito que copie de los excel de la misma carpeta los datos, que no siempre son el mismo rango, de una hoja llamada "almacenadas" y que comienzan en la celda B11 de todos los archivos y quisiera que en el archivo Overworkmaster pegara los datos a partir de esa celda.
Adicional, quiero saber si hay manera de exportar un hoja llamada "historico" de manera oculta a los archivos de la misma carpeta.
1 respuesta
H o l a: Vamos a resolver una petición por pregunta.
Pon la siguiente macro en tu libro "Overworkmaster", crea en este libro una hoja llamada "destino", en esta hoja se pegará la información.
Guarda tu libro en la misma carpeta donde tienes tus archivos a los que se les va a extraer el rango.
Sub Copiar_Rango()
'---
' Por.Dante Amor
'---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = Sheets("destino") 'hoja para poner los datos
'
h1.Rows(11 & ":" & Rows.Count).ClearContents
ruta = l1.Path & "\"
arch = Dir(ruta & "*.xls*")
Do While arch <> ""
If arch <> l1.Name Then
Set l2 = Workbooks.Open(ruta & arch)
existe = False
For Each h In l2.Sheets
If LCase(h.Name) = "almacenadas" Then
Set h2 = l2.Sheets("almacenadas")
existe = True
Exit For
End If
Next
If existe Then
uc = h2.Cells(11, Columns.Count).End(xlToLeft).Column
uf = h2.Range("B" & Rows.Count).End(xlUp).Row
h2.Range(h2.Cells(11, "B"), h2.Cells(uf, uc)).Copy
u1 = h1.Range("B" & Rows.Count).End(xlUp).Row + 1
h1.Range("B" & u1).PasteSpecial xlValues
End If
l2.Close False
End If
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Terminado"
End SubCrea una nueva pregunta para : "exportar un hoja llamada "historico" ", me explicas con detalle qué quieres exportar de dónde a dónde.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Dante Amor me da error de compilación a partir de :
h1.Rows(11& ":" & Rows.Count).ClearContents
ruta = l1.Path & "\"
arch = Dir(ruta & "*.xls*")
Do While arch <> ""
If arch <> l1.Name Then
Set l2 = Workbooks.Open(ruta & arch)
Y qué tienes en la hoja "destino", ¿tienes celdas combinadas o la hoja está protegida?
Intenta con una hoja nueva y la llamas "destino"
Copia bien la línea:
h1.Rows(11 & ":" & Rows.Count).ClearContents
Después del 11 debe haber un espacio y después el símbolo &
