Macro que copie datos a otra hoja, según criterio.
As):
Una consulta espero puedan ayudarme, tengo un archivo con los despachos programados por día.
1.- Tengo una plantilla con una hoja llamada "Ruteo", allí pego los datos desde la columna A1 hasta la R*** Variable, el rango de datos puede variar según los pedidos. (Como se muestra en la Foto 1)
2.- El tema es que almacén imprime hojas de Picking por cliente, y copia los datos de manera manual a la otra hoja del libro llamada "Picking". Es decir, en la hoja Ruteo filtra un cliente, por ejemplo Tiendas por Departamento Ripley, y los datos resaltados en celeste los pasa a la hoja Picking para que puedan imprimirlos.
Foto 1
Mi idea es que una macro haga este proceso. Es decir, cada vez que pegue en mi hoja "Ruteo" los datos desde la columna A1 hasta la R**** (Foto 1). Primero, se actualice una lista de clientes en la hoja Picking en la celda C2. Segundo, al desplegar esa lista, selecciono X cliente, lo que debería ejecutar la macro es, copiar los datos que le pertenecen a ese cliente, solo los resaltado en celeste en la Foto 1 y pegarlos en la hoja Picking a partir de la celda "A5", como se aprecia los encabezados desde A4:D4 son los mismos que los encabezados resaltados en celeste de la hoja "Ruteo" .
Espero se entienda mi idea, los datos en verde se llenan manualmente.
Asimismo, si toda esa hoja Picking puede ajustarse a rango de impresión.
A a espera de su valiosa ayuda.
Si no esta clara la idea favor me hacen saber para dar algún detalle adicional.
2 respuestas
Estimado Dante te envié lo solicitado, a la espera de tu soporte.
Hola Dam....Te llegó mi correo?
Te anexo la macro
Sub Extaer()
'Por.Dante Amor
Set h1 = Sheets("Ruteo")
Set h2 = Sheets("Picking")
'
u = h2.Range("A" & Rows.Count).End(xlUp).Row
If u < 7 Then u = 7
h2.Range("A7:J" & u).ClearContents
'
If h2.[D1] = "" Then
MsgBox "Falta el nombre del cliente", vbExclamation, "Picking"
Exit Sub
End If
If h2.[D2] = "" Then
MsgBox "Falta la categoría", vbExclamation, "Picking"
Exit Sub
End If
'
u = h1.Range("H" & Rows.Count).End(xlUp).Row
h1.Range("A1:R" & u).AutoFilter Field:=8, Criteria1:=h2.[D1]
h1.Range("A1:R" & u).AutoFilter Field:=7, Criteria1:=h2.[D2]
u = h1.Range("H" & Rows.Count).End(xlUp).Row
If u = 1 Then
MsgBox "No hay registros con los criterios seleccionados", vbExclamation, "Picking"
Exit Sub
End If
'
H1.Range("C2:F" & u). Copy h2. Range("A7")
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Estimado es la base de datos de la hoja1 - Llamada Ruteo.
Si necesitas algo adicional quedo atento.
Gracias de antemano.
Aquí esta la macro que considero te puede servir. Si te sirve por favor califica, si no házmelo saber y puedo seguir ayudándote.