Como traer Datos de un libro que contiene bases de datos a otro pero tiene que estar cerrado el libro de las bases.
Que tal buen día amigos expertos quisiera ver si me pueden ayudar con una macro que me diseño el buen Dante Amor, lo que pasa es que voy a mover unas hojas que contienen base de datos con formulas a otro libro esto para que no se haga lento mi archivo o modulo de captura de información y es la siguiente macro la uso ahorita pero, con tanta formula de las bases se a lenta el archivo y quiero cambiarla de referencia al otro libro nuevo para que no siga pasando eso, pero quiero que el libro donde contenga las bases de datos este Cerrado y el formato de captura este abierto espero y me apoyen.
1 respuesta
Te anexo la macro actualizada para leer el libro cerrado
Sub TraerDatos3()
'Por.Dante Amor
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Formato de Captura Calidad IRP")
ruta = l1.Path & "\"
'
libro2 = "libro2.xlsx"
'
If Dir(ruta & libro2) = "" Then
MsgBox "El libro 2 no existe", vbCritical
Exit Sub
End If
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set l2 = Workbooks.Open(ruta & libro2, ReadOnly:=True)
Set h2 = l2.Sheets("Respaldo General")
h1.Unprotect "romito"
'
i = 10
Do While Cells(i, "B") <> "" Or Cells(i + 1, "B") <> ""
i = i + 2
Loop
'
Set b = h2.Columns("A").Find(h1.[T3], LookAt:=xlWhole, LookIn:=xlValues)
If Not b Is Nothing Then
h1.Cells(i, "B") = h2.Cells(b.Row, "H") 'Orden de compra
h1.Cells(i, "C") = h2.Cells(b.Row, "E") 'Cons
h1.Cells(i, "D") = h2.Cells(b.Row, "F") 'Pda
h1.Cells(i, "E") = h2.Cells(b.Row, "G") 'Ent
h1.Cells(i + 1, "I") = h2.Cells(b.Row, "J") 'cantidad
h1.Cells(i + 1, "L") = h2.Cells(b.Row, "K") 'Fecha de Entrega
h1.Cells(i + 1, "N") = h2.Cells(b.Row, "L") 'Precio Unitario
h1.Cells(i, "P") = h2.Cells(b.Row, "M") 'No Factura
h1.Cells(i, "Q") = h2.Cells(b.Row, "N") 'No Lote
h1.Cells(i, "A") = h2.Cells(b.Row, "O") 'Cons de Vale
h1.Cells(i + 1, "J") = h2.Cells(b.Row, "P") 'Unidad
h1.Cells(i, "R") = h2.Cells(b.Row, "V") 'Retencion de muestra
h1.Cells(i, "T") = h2.Cells(b.Row, "W") 'No Analisis
h1.Cells(i, "V") = h2.Cells(b.Row, "Y") 'Fecha de aprobacion
h1.Cells(i, "W") = h2.Cells(b.Row, "Z") 'Fecha IRP
h1.Cells(i, "X") = h2.Cells(b.Row, "AA") 'IRP
h1.Cells(i, "AA") = h2.Cells(b.Row, "AB") 'Comentarios
Else
MsgBox "Número de folio no existe", vbExclamation
End If
l2.Close False
h1.Protect "romito"
End SubS a l u d o s . D a n t e A m o r
Recuerda valorar la respuesta.
Hola Buen día dante, espero que estés un poco mejor con lo papa animo y ya con lo de la macro donde cambiaría el nombre del archivo y su ruta.Saludos.
La ruta, actualmente toma la misma ruta donde tienes el libro con la macro, pero la puedes cambiar aquí:
ruta = l1.Path & "\"
Por ejemplo:
ruta = "C:\documentos\datos\etc"
El nombre del libro:
Libro2 = "libro2.xlsx"
Cambia, "libro2.xlsx" por el nombre del libro con todo y extensión.
S a l u d o s . D a n t e A m o r
Recuerda valorar la respuesta.
Hola Dante me sale el siguiente error me puedes echar la mano por fa:
En el ejemplo te puse esto:
ruta = "C:\documentos\datos\etc"
y tu pusiste esto:
ruta = l1.Path & "W:\Compras\Respaldo Carlos"
Tienes que ponerlo así:
ruta = "W:\Compras\Respaldo Carlos\"
Revisa bien el ejemplo, fíjate que al final debes poner la diagonal \
Nota: Cuando la macro genere un mensaje de error, tienes que enviarme el mensaje de error y la línea de la macro en donde se detiene.
S a l u d o s . D a n t e A m o r
Recuerda valorar la respuesta.
Me sigue dando error en la misa linea saludos.
Me da error en la linea de. If
Sub TraerDatos3()
'Por.Dante Amor
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Formato de Captura Calidad IRP")
ruta = l1.Path & "W:\Compras\Respaldo Carlos\"
'
libro2 = "Respaldo Vale de entrada.xlsx"
'
If Dir(ruta & libro2) = "W:\Compras\Respaldo Carlos\Respaldo Vale de entrada.xlsx" Then
MsgBox "Respaldo Vale de entrada.xlsx", vbCritical
Exit Sub
End If
Pero estás modificando la macro en lugares que NO te dije.
Esto que pusiste está mal
ruta = l1.Path & "W:\Compras\Respaldo Carlos\"
Debe ser así:
ruta = "W:\Compras\Respaldo Carlos\"
Esto que pusiste también está mal
If Dir(ruta & libro2) = "W:\Compras\Respaldo Carlos\Respaldo Vale de entrada.xlsx" Then
Debe ser así:
If Dir(ruta & libro2) = "" Then
Te anexo la macro con el cambio de la ruta y del nombre del archivo:
Sub TraerDatos3()
'Por.Dante Amor
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Formato de Captura Calidad IRP")
ruta = "W:\Compras\Respaldo Carlos\"
'
libro2 = "Respaldo Vale de entrada.xlsx"
'
If Dir(ruta & libro2) = "" Then
MsgBox "El libro 2 no existe", vbCritical
Exit Sub
End If
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set l2 = Workbooks.Open(ruta & libro2, ReadOnly:=True)
Set h2 = l2.Sheets("Respaldo General")
h1.Unprotect "romito"
'
i = 10
Do While Cells(i, "B") <> "" Or Cells(i + 1, "B") <> ""
i = i + 2
Loop
'
Set b = h2.Columns("A").Find(h1.[T3], LookAt:=xlWhole, LookIn:=xlValues)
If Not b Is Nothing Then
h1.Cells(i, "B") = h2.Cells(b.Row, "H") 'Orden de compra
h1.Cells(i, "C") = h2.Cells(b.Row, "E") 'Cons
h1.Cells(i, "D") = h2.Cells(b.Row, "F") 'Pda
h1.Cells(i, "E") = h2.Cells(b.Row, "G") 'Ent
h1.Cells(i + 1, "I") = h2.Cells(b.Row, "J") 'cantidad
h1.Cells(i + 1, "L") = h2.Cells(b.Row, "K") 'Fecha de Entrega
h1.Cells(i + 1, "N") = h2.Cells(b.Row, "L") 'Precio Unitario
h1.Cells(i, "P") = h2.Cells(b.Row, "M") 'No Factura
h1.Cells(i, "Q") = h2.Cells(b.Row, "N") 'No Lote
h1.Cells(i, "A") = h2.Cells(b.Row, "O") 'Cons de Vale
h1.Cells(i + 1, "J") = h2.Cells(b.Row, "P") 'Unidad
h1.Cells(i, "R") = h2.Cells(b.Row, "V") 'Retencion de muestra
h1.Cells(i, "T") = h2.Cells(b.Row, "W") 'No Analisis
h1.Cells(i, "V") = h2.Cells(b.Row, "Y") 'Fecha de aprobacion
h1.Cells(i, "W") = h2.Cells(b.Row, "Z") 'Fecha IRP
h1.Cells(i, "X") = h2.Cells(b.Row, "AA") 'IRP
h1.Cells(i, "AA") = h2.Cells(b.Row, "AB") 'Comentarios
Else
MsgBox "Número de folio no existe", vbExclamation
End If
l2.Close False
h1.Protect "romito"
End SubNO MODIFIQUES LA MACRO!
La macro funciona correctamente, pero si le haces cambios no va a funcionar.
S a l u d o s . D a n t e A m o r
Recuerda valorar la respuesta.
Hola Dante buen día oye la macro no me trae la información corre pero no la trae al libro me podrías ayudar.
Saludos.
Es difícil saber qué tienes en tus archivos, la macro funciona correctamente.
Si no te trae información es porque tus datos están incorrectos, tal vez en un archivo tienes letras y en el otro archivo tienes números o espacios y es por eso que no encuentra la información.
Realiza la prueba con un solo dato. Escribe en T3 la palabra "algo", en el libro2 borra todo y en la columna A, en la fila 3, escribe la palabra "algo", en esa misma fila escribe lo que quieras en todas las columnas.
Vuelve a ejecutar la macro.
Si te funciona el ejemplo, valora la respuesta.
Si no puedes con el ejemplo, envíame tus 2 archivos.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “juan carlos mendoza garcia” y el título de esta pregunta.
