Exportar rango de celdas a libros del mismo directorio en hoja oculta
Necesito exportar del libro "overworkmaster" de la hoja "histórico" las celdas que parten de A1 y pegarlos en la misma posición, a los libros del mismo directorio, pero en esos libros la hoja "histórico" se encuentra oculto.
1 Respuesta
Te anexo la macro. De igual forma revisa que los espacios en las instrucciones de la macro estén correctos
Sub Copiar_Rango()
'---
' Por.Dante Amor
'---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = Sheets("destino") 'hoja para poner los datos
Set h11 = Sheets("historico") 'hoja historico
'
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
existe_hist = False
For Each h In l2.Sheets
Select Case LCase(h.Name)
Case "almacenadas"
Set h2 = l2.Sheets("almacenadas")
existe = True
Case "historico"
Set h21 = l2.Sheets("historico")
existe_hist = True
End Select
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
If existe_hist Then
h11.Cells.Copy h21.Range("A1")
End If
l2.Close True
End If
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Terminado"
End Subavísame cualquier duda
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Me copia los valores incompletos a los archivos del directorio. Puedo ver en el código que me mandas aquí que hay condicionantes distintas como la celda "almacenadas". Lo único que quiero es exportar desde overworkmaster a los libros del directorio la hoja "historico".
Agradezco tu ayuda
Entonces no entendí qué necesitas.
Explicame con ejemplos claros de lo que tienes y de lo que esperas como resultado.
Pon varias imágenes explicando paso a paso qué tienes y qué esperas como resultado, ve explicando paso a paso lo que necesitas y por cada paso pones una imagen, en la imagen, se debe ver claramente la información, las filas y las columnas de excel, el nombre de la hoja y el nombre del libro, entre más claro sea tu ejemplo, más práctico podré entregarte la solución.
Para copiar los datos de la hoja "historico" del libro que tiene la macro a los demás libros en la hoja historico
Sub Copiar_Rango()
'---
' Por.Dante Amor
'---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h11 = Sheets("historico") 'hoja historico
'
ruta = l1.Path & "\"
arch = Dir(ruta & "*.xls*")
Do While arch <> ""
If arch <> l1.Name Then
Set l2 = Workbooks.Open(ruta & arch)
existe_hist = False
For Each h In l2.Sheets
Select Case LCase(h.Name)
Case "historico"
Set h21 = l2.Sheets("historico")
existe_hist = True
End Select
Next
If existe_hist Then
h11.Cells.Copy h21.Range("A1")
End If
l2.Close True
End If
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Terminado"
End Subsal u dos
