Replicar contenido de un fichero origen a otros dos ficheros destino.

[mrive]

Hola a tod@s,
En primer lugar no se si este es el foro adecuado para plantear mi problema. En caso de que no sea, ruego me indiquen cual seria el adecuado y pido disculpas.

Lo que necesito es poder replicar cualquier cambio que se haga dentro de la hoja en un fichero denominado Origen1.xlsx 
en otros dos ficheros respectivamente que se denominan:  Destino1mismaextension.xlsx y Destino2mismaextension.xlsx.

Adjunto el fichero de Origen y otro de destino porque no me entran los 3 por tamaño, pero el tercero lo añadiría en caso necesario mas adelante.

Muchas gracias de antemano.

Replica.zip

[Israel Cassales]

En base a lo explicado sí puedes,  aunque es importante que los dos libros de Excel tengan la misma estructura para que los datos se correspondan correctamente.

 

[Israel Cassales]

Opción con VBA

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Destino As Workbook
    Dim ws As Worksheet

    ' Abre el libro de destino
    Set Destino = Workbooks.Open("ruta completa del archivo\Destino2mismaextension.xlsx")
    
    ' Selecciona la hoja de destino
    Set ws = Destino.Worksheets("Almacen_RT")
    
    ' Copia los cambios a la hoja de destino
    Target.Copy ws.Range(Target.Address)

    ' Guarda y cierra el libro de destino
    Destino.Close SaveChanges:=True
End Sub

Este código debe ser colocado en el módulo de la hoja “Almacen_RT” del libro “Origen1.xlsx”.

Reemplaza "ruta completa del archivo\Destino2mismaextension.xlsx" con la ruta completa del archivo de destino. Este código se activará cada vez que hagas un cambio en la hoja “Almacen_RT” del libro “Origen1.xlsx”, y replicará el cambio en la hoja “Almacen_RT” del libro “Destino2mismaextension.xlsx”.

[Israel Cassales]

Opción con vínculos:

1. Abre ambos libros de Excel, “Origen1.xlsx” y “Destino2mismaextension.xlsx”.

2. En el libro “Destino2mismaextension.xlsx”, selecciona la celda donde quieres que aparezca la información.

3. Escribe = en esa celda.

4. Cambia a la ventana de “Origen1.xlsx” y selecciona la celda que contiene la información que quieres vincular.

5. Presiona Enter.

Ahora, cualquier cambio que hagas en la celda del libro “Origen1.xlsx” se reflejará automáticamente en la celda correspondiente del libro “Destino2mismaextension.xlsx”.

Ten en cuenta que este método solo funciona si ambos libros están abiertos al mismo tiempo. Si el libro “Origen1.xlsx” está cerrado, Excel no podrá actualizar la información en “Destino2mismaextension.xlsx”.

[Israel Cassales]

Opción Power Query:

Esta es una herramienta de Excel que te permite importar datos de varias fuentes y transformarlos según tus necesidades.

1. Abre el libro “Destino2mismaextension.xlsx”.

2. Ve a la pestaña “Datos” en la cinta de opciones y selecciona “Obtener datos” > “Desde archivo” > “Desde Workbook”.

3. Navega hasta el libro “Origen1.xlsx” y haz clic en “Importar”.

4. En el cuadro de diálogo del Navegador, selecciona la hoja “Almacen_RT” y haz clic en “Cargar”.

Ahora, cualquier cambio que hagas en la hoja “Almacen_RT” del libro “Origen1.xlsx” se reflejará automáticamente en la hoja correspondiente del libro “Destino2mismaextension.xlsx” cuando actualices la consulta en “Destino2mismaextension.xlsx”.

Ten en cuenta que este método requiere que actualices la consulta manualmente o establezcas actualizaciones automáticas para ver los cambios en tiempo real.

Saludines

[mrive]

Hola Israel,

Muchas gracias por tu ayuda. Lo comprobare y te comento.

Un  saludo.

[mrive]

Hola Israel,

He realizado pruebas pero no me funciona el código. Estoy intentando realizar cambios sobre lo que me indicaste pero no hace ningún cambio en el fichero destino y tampoco da error. Seguiré haciendo pruebas. Gracias por todo.

[Israel Cassales]

Si el código te da problemas intenta lo siguiente:

1. Ubicación del código: El código VBA debe estar en el módulo de la hoja “Almacen_RT” en “Origen1.xlsx”. Para verificar esto, abre el Editor, expande el objeto “ThisWorkbook” en el panel del Explorador de proyectos y haz doble clic en “Almacen_RT” para abrir el módulo de la hoja.

2. Ruta del archivo de destino: Asegúrate de que la ruta del archivo de destino en el código VBA sea correcta. Debe ser la ruta completa del archivo, incluyendo la extensión del archivo (por ejemplo, C:\Users\TuNombre\Documents\Destino2mismaextension.xlsx).

3. Guardar cambios: El código VBA guarda y cierra el libro de destino después de copiar los cambios. Si tienes el libro de destino abierto mientras haces cambios en el libro de origen, es posible que no veas los cambios. Intenta cerrar y volver a abrir el libro de destino para ver si los cambios se han realizado.

4. Intenta alguna de las otras dos opciones.

[mrive]

Ok.

Con lo que sea te digo.

Gracias.

[mrive]

Hola de nuevo Israel y perdón por tardar en responder,

Pero he conseguido crear un código  que si me funciona y replica los cambios pero lo único que me faltaría seria que replicara también los códigos QR, que no lo doy conseguido. El resto funciona. Añado el código para que lo puedas valorar y agradecerte mucho tu ayuda.

Este seria el código:

Private Sub Workbook_Open()

    ' Declara variables
    Dim wbOrigen As Workbook
    Dim wsOrigen As Worksheet
    Dim wbDestino As Workbook
    Dim wsDestino As Worksheet
    Dim strMacroName As String

    ' Abre el libro origen
    Set wbOrigen = Workbooks.Open("C:\Temp\Origen1.xlsm")

    ' Selecciona la hoja origen
    Set wsOrigen = wbOrigen.Worksheets("Almacen_RT")

    ' Abre el libro destino
    Set wbDestino = Workbooks.Open("C:\Temp\Destino1mismaextension.xlsx")

    ' Selecciona la hoja destino
    Set wsDestino = wbDestino.Worksheets("Almacen_RT")

    ' Pide al usuario el nombre de la macro
    strMacroName = "Mover datos"

    ' Copia los cambios a la hoja de destino
    wsDestino.Range("A2").Resize(wsOrigen.Range("A2:N1648").Rows.Count, wsOrigen.Range("A2:N1648").Columns.Count).Value = wsOrigen.Range("A2:N1648").Value

    ' Guarda los cambios automáticamente
    If Not wbDestino.Saved Then
        wbDestino.Save
    End If

    ' Cierra el libro destino
    wbDestino.Close

End Sub
 

Un saludo.

[Israel Cassales]

Para replicar los QR, necesitarás agregar una lógica adicional para copiar las imágenes así que podrías necesitar trabajar con los objetos Picture o Shape.

Te comparto una modificación de tu código que incluye la copia de los QR. Importante: Toma en cuenta estoy asumiendo que los códigos QR están la columna K, y no en todas las celdas. Recuerda la importancia que la hoja destino tiene el mismo diseño que el origen.

Private Sub Workbook_Open()

    ' Declara variables
    Dim wbOrigen As Workbook
    Dim wsOrigen As Worksheet
    Dim wbDestino As Workbook
    Dim wsDestino As Worksheet
    Dim strMacroName As String
    Dim i As Long

    ' Abre el libro origen
    Set wbOrigen = Workbooks.Open("C:\Temp\Origen1.xlsm")

    ' Selecciona la hoja origen
    Set wsOrigen = wbOrigen.Worksheets("Almacen_RT")

    ' Abre el libro destino
    Set wbDestino = Workbooks.Open("C:\Temp\Destino1mismaextension.xlsx")

    ' Selecciona la hoja destino
    Set wsDestino = wbDestino.Worksheets("Almacen_RT")

    ' Pide al usuario el nombre de la macro
    strMacroName = "Mover datos"

    ' Copia los cambios a la hoja de destino
    wsDestino.Range("A2").Resize(wsOrigen.Range("A2:N425").Rows.Count, wsOrigen.Range("A2:N425").Columns.Count).Value = wsOrigen.Range("A2:N425").Value

    ' Copia los códigos QR de la columna K (solo si la celda no está vacía)
    For i = 2 To 425 ' Ajusta el rango según tus necesidades
        If Not IsEmpty(wsOrigen.Cells(i, 11).Value) Then
            ' Copia el contenido de la celda con el código QR
            wsDestino.Cells(i, 11).Value = wsOrigen.Cells(i, 11).Value
        End If
    Next i

    ' Guarda los cambios automáticamente
    If Not wbDestino.Saved Then
        wbDestino.Save
    End If

    ' Cierra el libro destino
    wbDestino.Close

End Sub

Es posible que debas personalizar.

Saludines

[mrive]

Buenos días Israel,

Lo probaré. Muchas gracias. Un saludo.

[mrive]

Hola de nuevo Israel,

Perdón por la tardanza en todo esto pero hice numerosas pruebas y si parece que funciona el código pero al final no  copia los códigos QR. El resto funciona perfectamente. El código que tengo ahora con algunos cambios respecto al tuyo es este:

Sub MoverDatosQR()

' Declara variables
Dim wbOrigen As Workbook
Dim wsOrigen As Worksheet
Dim wbDestino As Workbook
Dim wsDestino As Worksheet
Dim strMacroName As String
Dim i As Long

' Abre el libro origen
Set wbOrigen = Workbooks.Open("C:\Temp\Origen1.xlsm")

' Selecciona la hoja origen
Set wsOrigen = wbOrigen.Worksheets("Almacen_RT")

' Abre el libro destino
Set wbDestino = Workbooks.Open("C:\Temp\Destino1mismaextension.xlsx")

' Selecciona la hoja destino
Set wsDestino = wbDestino.Worksheets("Almacen_RT")

' Pide al usuario el nombre de la macro
strMacroName = "Mover datos"

' Copia los cambios a la hoja de destino
wsDestino.Range("A2").Resize(wsOrigen.Range("A2:N425").Rows.Count, wsOrigen.Range("A2:N425").Columns.Count).Value = wsOrigen.Range("A2:N425").Value

' Copia los códigos QR de la columna K (solo si la celda no está vacía)
For i = 2 To 425 ' Ajusta el rango según tus necesidades
If Not IsEmpty(wsOrigen.Cells(i, 11).Value) Then
' Copia la imagen del código QR
If [Type(wsOrigen.Cells(i, 11).GraphicObject.ShapeRange) = xlTypePicture] Then
    wsDestino.Cells(i, 11).Picture = wsOrigen.Cells(i, 11).GraphicObject.ShapeRange.Copy()
   Else
    MsgBox Str("El código QR en la celda " & i & " no es una imagen.")
   End If
End If
Next i

' Guarda los cambios automáticamente
If Not wbDestino.Saved Then
wbDestino.Save
End If

' Cierra el libro destino
wbDestino.Close

End Sub

Creo que me voy a dar por vencido por el momento hasta que encuentre otra solución.

Si se te ocurre algo te lo agradezco de nuevo.

Muchas gracias por todo tu esfuerzo y dedicación.

Un saludo.

 

[Israel Cassales]

Entiendo.

Pues por aquí andamos, espero de verdad que logres el resultado que necesitas.

[mrive]

Muchas gracias. Un saludo.