Macro para buscar datos y pegar en hojas diferentes
Para: Dante Amor.
Hola Dante, si me puedes ayudar con una macro. Te explico
Tengo un archivo de excel que tiene 5 hojas, las hojas tienen los siguientes nombres y en este mismo orden... RS, BV, MP, Pedido, Entrega.
En la hoja Pedido están todos los pedidos hechos a un proveedor para los deptos RS, BV, MP. En la hoja Entrega están las entregas hechas por el proveedor de acuerdo a lo que se pidió en la hoja Pedido. Lo que necesito es que la macro me escoja las filas de datos que corresponden de acuerdo al dpto, y lo pegue a la hoja que le corresponde del acuerdo al nombre del dpto. El problema es que en la columna dptos de la hoja Pedido no aparece los nombres RS, BV, MP sino que se registran en números de dptos, por lo cual hay que decirle a la macro que reconozca al dpto de acuerdo al numero que le corresponde. Te detallo el numero que le corresponde a cada dpto
RS=100
BV=200
MP=400
En la hoja Pedido, los dptos están en la columna ¨D¨
La columnas que quiero que se peguen en las respectivas hojas son las siguientes: E, F, G, H, I, J
Al momento de copiar y pegar es desde la fila 2 ya que en la fila 1 están los títulos de las columnas. Las cantidades de filas pueden variar.
A la vez que copia los datos de la hoja Pedido debe comparar con la hoja Entrega para comprobar que lo que se pidió fue entregado y la cantidad entregada debe ser copiada y pegada en la columna K de cada hoja dpto (RS, BV, MP), si alguna linea que se pidió no fue entregada entonces colocar ¨0¨ en esa linea. Los datos donde estan las cantidades entregadas de la hoja Entrega están en la columna I. Ahora se que necesitas comparar cada linea de la hoja Pedido con la hoja Entrega de acuerdo al dpto, para eso comparas los datos de la columna F de la hoja Pedido con los datos de la columna D de la hoja Entrega, que es donde están los códigos de barra, los cuales son únicos. Los dptos en la hoja Entrega están en la columna B.
Si necesitas alguna otra información.
H o la: Envíame tu archivo con varios ejemplos y me explicas un par de ellos.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Ramon Camacho” y el título de esta pregunta.
Hola Dante...
Ya te envié el correo. Muchas gracias
Te anexo la macro
Sub Copiar_Inventario()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("Pedido")
Set h2 = Sheets("Entrega")
deptos = Array(100, 200, 400)
hojas = Array("RS", "BV", "MP")
For h = LBound(hojas) To UBound(hojas)
Sheets(hojas(h)).Range("A2:G" & Rows.Count).ClearContents
Next
For i = 2 To h1.Range("F" & Rows.Count).End(xlUp).Row
ndepa = h1.Cells(i, "D")
ncodb = h1.Cells(i, "F")
existe = False
For d = LBound(deptos) To UBound(deptos)
If ndepa = deptos(d) Then
existe = True
Set h3 = Sheets(hojas(d))
Exit For
End If
Next
If existe Then
If ncodb <> "" Then
entrega = 0
Set r = h2.Columns("D")
Set b = r.Find(ncodb, lookat:=xlWhole)
If Not b Is Nothing Then
celda = b.Address
Do
'detalle
If h2.Cells(b.Row, "B") = ndepa Then
entrega = h2.Cells(b.Row, "H")
Exit Do
End If
Set b = r.FindNext(b)
Loop While Not b Is Nothing And b.Address <> celda
End If
'
u3 = h3.Range("B" & Rows.Count).End(xlUp).Row + 1
h1.Range(h1.Cells(i, "E"), h1.Cells(i, "J")).Copy h3.Cells(u3, "A")
h3.Cells(u3, "G") = entrega
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Excelente, me funciona a la perfección.
Si en un futuro deseo agregar más dptos, imagino que los debo agregar en esta parte
deptos = Array(100, 200, 400)
hojas = Array("RS", "BV", "MP")Muchas gracias por tu ayuda Dante
Así es, cada número de depto con su correspondiente nombre de hoja
