Copiar datos de un libro a otro según condición

Uso esta macro para pasar datos de hoja BC_14 a hoja 3101, y así 10 hojas pero ahora tengo la hoja BC_14 en un libro y las otras en un libro por cada hoja

Como puedo cambiar la macro para que abra los libros aplique la macro y los cierre

Gracias de antemano, y buenas tardes

Sub Sumaria3101()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
Sheets("BC_14").Activate
j = 15
For i = 15 To 10000
If Cells(i, "G").Value = 3101 Then
Range(Cells(i, "ET"), Cells(i, "FE")).Copy Destination:=Sheets("3101").Cells(j, "C")
j = j + 1
End If
Next
Sheets("3101").Activate
Call Suma
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True
.CutCopyMode = False
End With
End Sub

1 Respuesta

Respuesta
2

El bucle parece que debe copiar todo lo que encuentre como 3101 o un libro, por lo tanto el código agregado abre y cierra el libro destino antes y después del bucle.

Sub Sumaria3101()
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .EnableEvents = False
End With
ActiveSheet.DisplayPageBreaks = False
'guarda nbre del libro origen para regresar
lib1 = ActiveWorkbook.Name
Sheets("BC_14").Activate
j = 15
'se abre el libro destino. Si no se conoce la ruta se lo busca con las siguientes instrucciones:
    'la variable guarda la ruta y nombre del archivo a abrir
    milibro = Application.GetOpenFilename
    'si la variable está vacía significa que cancelamos la ventana de diálogo
    If milibro = False Then
        MsgBox "No se asignó el libro destino, el proceso se cancela."
        Exit Sub
    End If
    'abrir el libro elegido
    Workbooks.Open milibro
    lib2 = ActiveWorkbook.Name
    'se vuelve a activar el libro origen
    Workbooks(lib1).Activate
For i = 15 To 10000
    If Cells(i, "G").Value = 3101 Then
    Range(Cells(i, "ET"), Cells(i, "FE")).Copy Destination:=Workbooks(lib2).Sheets("3101").Cells(j, "C")
    j = j + 1
    End If
Next
'se activa el libro destino para ejecutar la suma -- REVISAR
Workbooks(lib2).Activate
ActiveWorkbook.Sheets("3101").Select
Call Suma    'REVISAR
'se cierra el libro destino guardando los cambios
ActiveWorkbook.Close True
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    .CutCopyMode = False
End With
End Sub

Aquí lo que sucede es que te permite buscar el libro destino.... si ya conoces su nombre y ruta podes ajustar ese detalle o consultarlo en otra entrada.

Si por cada valor dentro del bucle For i se debe realizar la copia y suma en libros distintos, las instrucciones de apertura y cierre van dentro del bucle For i = 15 to ...

Probalo y luego si hace falta ajustarlo podés solicitar aclaraciones.

Elsa

Muchas gracias, funciona perfectamente.

Podría abrir cada libro automáticamente, sabiendo el nombre de este?

Nota: Una disculpa por contestar hasta ahora, salí de vacaciones por la semana Santa

Si ya sabés el nombre del libro quitá estas líneas:

'se abre el libro destino. Si no se conoce la ruta se lo busca con las siguientes instrucciones:
    'la variable guarda la ruta y nombre del archivo a abrir
    milibro = Application.GetOpenFilename
    'si la variable está vacía significa que cancelamos la ventana de diálogo
    If milibro = False Then
        MsgBox "No se asignó el libro destino, el proceso se cancela."
        Exit Sub
    End If

Y a continuación sigue este comentario:

'abrir el libro elegido

Allí agregá la ruta o carpeta donde se encuentre el libro y su nombre con la extensión. Y luego todo el código como estaba:

milibro = ruta & "/" & "Nombre_del_libro.xlsm"   'ajustar nombre y extensión
    Workbooks. Open milibro

Si se encuentra en la misma ubicación que el libro activo tendrás:

ruta = ThisWorkbook.Path

Considerando que según tus palabras 'funciona perfecto' y con esta aclaración creo que ya no habrá más nada que comentar.

Si te queda algún otro cambio deberás valorar estas respuestas (Excelente o buena) y luego dejar una nueva consulta en el tablón ... yo ya no estaré disponible (ahora me toca a mí salir de vacaciones ;)

¡Gracias!  funciona excelente, felices vacaciones

Pero que valoración tan pobre para algo que 'funciona excelente".

Sdos!

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas