Acabo de escribir (copiando un`poco de aqui y de alli) una macro que llama a un libro y copia sus datos en el libro activo. Como me interesa copiar todas las hojas en función de una condición, establecida en la celda A2 de cada pagina, hay una instrucción macro para cada hoja _origen- hoja destino. Ejecutasa una a una funcionan perfectamente.
Para no tener que ejecutar macro a macro, también hay un modulo macro para ejecutarlas a todas, pero este modulo da error de ejecución.
Codigo de cada macro:
Sub importar_entrelibros_YY()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Dim id_grupo As String
Dim grupo As String
Dim filadestino As Integer
Dim fichero_origen As String, hoja_origen As String
Dim fichero_destino As String, hoja_destino As String
Dim ruta As String
Dim Cell As range
On Error GoTo ManejadorError
ruta = "\\xxx\ xxx_xxx_xxx\TABLAS DATOS\"
fichero_origen = "tablas_memoria.xlsx"
hoja_origen = "Resumen_xxx"
fichero_destino = "Actividad YY.xlsm"
hoja_destino = "xxx"
'La variable id_grupo indica el dpto a copiar
id_grupo = Sheets(hoja_destino).range("A2").Value
'variable que indica a partir de qué fila se copiará
filadestino = 4
'ABRIMOS EL FICHERO CON LOS DATOS A COPIAR
Workbooks.Open Filename:=ruta & fichero_origen
'Seleccionar celda B2, *primera línea de datos*.
Sheets(hoja_origen).Activate
Sheets(hoja_origen).range("B2").Select
' Configurar el bucle Do para que se detenga al llegar a una celda vacía.
Hola Otra vez,
Acabo de escribir (copiando un`poco de aqui y de alli) una macro que llama a un libro y copia sus datos en el libro activo. Como me interesa copiar todas las hojas en función de una condición, establecida en la celda A2 de cada pagina, hay una instrucción macro para cada hoja _origen- hoja destino. Ejecutasa una a una funcionan perfectamente.
Para no tener que ejecutar macro a macro, también hay un modulo macro para ejecutarlas a todas, pero este modulo da error de ejecución.
Codigo de cada macro:
Sub importar_entrelibros_YY()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Dim id_grupo As String
Dim grupo As String
Dim filadestino As Integer
Dim fichero_origen As String, hoja_origen As String
Dim fichero_destino As String, hoja_destino As String
Dim ruta As String
Dim Cell As range
On Error GoTo ManejadorError
ruta = "\\xxx\ xxx_xxx_xxx\TABLAS DATOS\"
fichero_origen = "tablas_memoria.xlsx"
hoja_origen = "Resumen_xxx"
fichero_destino = "Actividad YY.xlsm"
hoja_destino = "xxx"
'La variable id_grupo indica el dpto a copiar
id_grupo = Sheets(hoja_destino).range("A2").Value
'variable que indica a partir de qué fila se copiará
filadestino = 4
'ABRIMOS EL FICHERO CON LOS DATOS A COPIAR
Workbooks.Open Filename:=ruta & fichero_origen
'Seleccionar celda B2, *primera línea de datos*.
Sheets(hoja_origen).Activate
Sheets(hoja_origen).range("B2").Select
' Configurar el bucle Do para que se detenga al llegar a una celda vacía.
Do Until IsEmpty(ActiveCell)
grupo = ActiveCell.Value
If id_grupo = grupo Then
Selection.EntireRow.Copy
Windows(fichero_destino).Activate
Sheets(hoja_destino).range("A" & filadestino).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
filadestino = filadestino + 1
Windows(fichero_origen).Activate
End If
' Bajar 1 fila de la ubicación actual.
ActiveCell.Offset(1, 0).Select
Loop
Application.CutCopyMode = False
'CERRAMOS EL EXCEL DE ORIGEN
Windows(fichero_origen).Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Exit Sub
ManejadorError:
If Err.Number <> 0 Then
Msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
Application.CutCopyMode = False
End Sub
Asi hasta 8 veces. Claro, cuando las junto con
Call 1
Call 2
Call 3
No funciona.
Gracias