Saltar al contenido

IMPORTAR INFORMACIÓN NUEVA DE UN LIBRO A OTRO EN DIFERENTES RUTAS


Recommended Posts

publicado

Hola a todos!!

 

Soy bastante principiante en las macros y no se cómo resolver esta.

Tengo un libro origen que actualizo diariamente  las filas ( a veces tengo que quitar registros pero la mayoría añado)

y quiero trasladar esa misma información a otro fichero histórico con las mismas columnas a otra ruta.

Me gustaría que en el libro destino tuviera un botón para importar los nuevos datos del origen si tener.

Por favor a ver si me pueden ayudar.Millones de gracias de antemano.

Conseguí esta macro por internet y la modifique para mi pero no me funciona. Me pone error sobre todo en el procedimiento que marco en verde.

 

Sub Importarcobros()

'Defino las variables a usar

Dim wborigen As Workbook
Dim wsorigen As Worksheet
Dim wbdestino As Workbook
Dim wsdestino As Worksheet

Dim ruta As String

ruta = "W:L\COBROS_2019 _PRUEBA_MACRO.xlsx"


'Llamamos a los datos de destino,solo tiene que estar abierto este libro


Set wblibrodestino = Workbooks(ThisWorkbook.Name)

Set wsHojaDestino = wblibrodestino.Worksheets("Cartera_actual")

'Llamamos a los datos de origen, no tiene que estar abierto este libro

Set wblibroOrigen = Workbooks.Open(ruta)

Set wshojaorigen = wblibroOrigen.Worksheet("Cartera actual")

uFila = wshojaorigen.Range("A" & Rows.Count).End(xlUp).Row

wshojaorigen.Range("A3:Z" & uFila).Copy Destination:=wsHojaDestino.Range("A" & Rows.Count).End(xlUp).Row

Workbooks(wblibroOrigen.Name).Close Savechanges:=False

End Sub

publicado

En la próxima consulta, recuerda subir los archivos necesarios para probar tu consulta.

Sub CopiarCarteraAlHistórico()
Dim FilaO As Long, FilaD As Long

'--
Workbooks.Open "F:\Mi archivo.xlsx" '<--- Modificar según necesidades
'--

With ActiveWorkbook.Sheets("Cartera_actual")
   FilaO = .Range("A" & Rows.Count).End(xlUp).Row
   FilaD = ThisWorkbook.Sheets("Cartera_actual").Range("A" & Rows.Count).End(xlUp).Row + 1
   .Range("A3:Z" & FilaO).Copy ThisWorkbook.Sheets("Cartera_actual").Range("A" & FilaD)
End With
ActiveWorkbook.Close
End Sub

 

publicado

Hola Antoni!

 

En primer lugar, mil gracias  por tu ayuda.  La estoy probando y funciona genial!! Una duda, si por lo que sea del origen quito un registro antiguo, también se actualiza?

De nuevo millones de gracias por la aportación!!!!

publicado

Esta macro copia  todo el contenido de la hoja Cartera_Actual del libro origen y lo añade al final de  la hoja Cartera_Actual del libro activo.

publicado
Hace 20 horas, Lydia dijo:

Hola Antoni! El problema que me surge con esto que es que duplica resgitros. La columna "CR RACMO" es como un id identificativo si es nuevo, podría copiar solo las filas en las que esa columna sea diferente? Disculpar por no haberlo dicho antes y lo siento, no puedo subir el archivo por Ley de porteccion de datos! mil gracias de nuevo

 

 

publicado

Suponiendo que el ID está en la columna A:

Sub CopiarCartera()
Dim FilaO As Long, FilaD As Long, Id As Range, Destino As Worksheet
Application.ScreenUpdating = False
Set Destino = ThisWorkbook.Sheets("Cartera_actual")
Workbooks.Open "F:\Mi archivo.xlsx" '<--- Modificar según necesidades
With Sheets("Cartera_actual")
   FilaO = .Range("A" & Rows.Count).End(xlUp).Row
   For x = 3 To FilaO
      Set Id = Destino.Columns("A").Find(.Range("A" & x), , , xlWhole) 'Busca ID
      If Id Is Nothing Then
         FilaD = Destino.Range("A" & Rows.Count).End(xlUp).Row + 1
         .Range("A" & x & ":Z" & x).Copy Destino.Range("A" & FilaD)
      End If
   Next
End With
ActiveWorkbook.Close
End Sub

 

publicado

Muchas gracias Antoni! ahora no me coge duplicados así que fenomenal, pero si borro un registro del libro origen  que ya estaba contenido en el de destino, no se me actualiza...Cómo puedo arreglar eso? De nuevo muchas gracias por todo.

publicado

Vamos a ver si nos aclaramos de una vez, porqué a trocitos no hay manera de hacer nada:

Situaciones:

  1. Está en Origen y no está en Destino --> Se añade a Destino
  2. Está en Origen y está en Destino       --> ¿No se hace nada o se sustituye Destino por Origen?
  3. Está en Destino y no está en Origen --> Se elimina de Destino

Define con exactitud lo que quieres.

 

publicado

Mil disculpas porque seguro que no me explico adecuadamente y encima no puedo adjuntar los archivos por ley de protección de datos .

Trato de explicarme desde el principio. Tengo un libro excel con cobros desde septiembre 2018 hasta actual que voy aumentando cada día registros (origen). Este libro contienes desde este mes, porque contiene más hojas con tablas dinámicas para análisis de datos para el jefe. Este tiene las mismas columnas o o por lo menos las principales comunes del archivo destino de cobros 2018 hasta actual. 

 

Para otro jefe , quiere un archivo "histórico"  es decier completo desde l 2018 hasta ahora,con las mismas columnas y registros pero desde el 2018 entero hasta la fecha. El problema es que el cliente a veces me quita registros del fichero origen... es decir, lo que ya he grabado.

 

En definitiva, lo que desearía, si se puede hacer, es que los registros del fichero origen se añadieran al de destino sin duplicar por el id de la columna  "cr racmo" que es única y si se borra del fichero origen algún registro que ya esté en el de destino. también se actualice. En conclusión tengo un histórico del fichero destino que contiene registros hasta agosto 2018. El fichero origen contiene datos desde setiembre 2018 hasta actual que cada día se añaden o se borran registros según ciertas  circunstancias. Su macro última funciona a la perfección a excepción de si se si borra un nuevo registro, no lo considera.  Quiero que sea una foto de lo que actualmente  vaya registrando en el fichero origen,  por lo que faltaría es alguna sentencia (la cual no se´) que si por ese id ya no está en el fichero origen, no la incluya.

Lo siento por la dificultad de explicar  y mil gracias por todo! por adelantado!

publicado

Hola @Lydia

Hace 46 minutos , Lydia dijo:

Mil disculpas porque seguro que no me explico adecuadamente y encima no puedo adjuntar los archivos por ley de protección de datos .

No tienes que mandar datos confidenciales, suficiente con archivos como muestras con datos ficticios pero con la estructura real de tus archivos, en los mismos debes poner un antes y un después, según los eventos que suceden, tu lo tienes claro, pero nosotros, no

Por favor de paso lee las normas del foro

 

Saludos

publicado
Hace 10 horas, Antoni dijo:

Vamos a ver si nos aclaramos de una vez, porqué a trocitos no hay manera de hacer nada:

Situaciones:

  1. Está en Origen y no está en Destino --> Se añade a Destino
  2. Está en Origen y está en Destino       --> ¿No se hace nada o se sustituye Destino por Origen?
  3. Está en Destino y no está en Origen --> Se elimina de Destino

Define con exactitud lo que quieres.

 

¿Que parte no entiendes de lo que tienes que aclarar? Es fácil ¿No?

 

publicado

Hola!!

Disculpad ante todo.

Perdón Antoni, te contesto por puntos:

1 SI, se añade a destino

2 No se hace nada

3.Se elimina de destino.

 

Gracias de antemano.

 

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29

    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • Exelente solución mil gracias 
  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.