Agrupacion de Macros que llaman a otro libro

[locosx]

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

[locosx]

Hola,

Nadie contesta, ...., no sabia que era algo tan dificil.

Más pistas: ejecutandolas una a una si que funciona y al juntarlas no. He detectado que si ejecuto desde una hoja activa distinta a la que corresponde no funcionan, por lo que el problema al juntarlas esta en que la instrucción para que active la hoja correspondiente no debe estar bien.

A alguien se le ocurre algo para solucionar esto?

Gracias