Inventario macro,filtra,copiar,pegar,vaciar

[childres12]

Hola que tal soy nuevo en el foro y estoy realizando un pequeño inventario , solo que tengo muy poco conocimiento sobre el tema de vba , espero alguien me pueda ayudar con la siguente cuestion

1. tengo una tengo una hoja llamada bodega y tengo una hoja llamda interfase(ahi capturo mis entradas)

2. en la hoja llamada bodega tengo las ubicaciones disponibles

3,quiero que al presionar un boton( despues de realizar mi captura ) me busque los datos de un rango (interfase) en la hoja llamda bodega me los filtre , copie lo de las siguientes celdas segun corresponda y pegue los datos (bodega)

4 por ultimo me limpie el area de captura

nota: de ser posible no importando que la hoja se encuentre oculta (bodega)

adjunto un archivo espero ser explicativo de antemano agradesco su ayuda

MI INVENTARIO.rar

[alucard2011]

que tal childres12 te anexo archivo y te comento que en la columna A lo pongo todo como almacen 1 ya que no vi de donde viene ese valor un saludo.

MI INVENTARIO II.xls

[childres12]

Que tal de hecho el almacén 1 nunca cambia es el nombre de el lugar donde se encuentran las ubicaciones

tu archivo me parece genial , pero el detalle es que tampoco las ubicaciones cambian es decir que solo tengo esas 20 ubicaciones fijas pero no puedo repetir el para evitar tener en mi inventario doble producto no se si me explico (digamos que ubico dicho producto en mi en a-1-1 para esto esta ubicacion debe estar vacia fisica y en sistema no quiero que crezca la lista ) de antemano gracias y espero se pueda saludos

[alucard2011]

Que tal childres12 pues sigo sin entender lo que necesitas te parece si del primer archivo que anexaste al foro en la pestaña hoja3 que esta en blanco me pones como deberian de quedar los datos que tienes en bodega mas el filtro y el copiado de los datos de la pestaña interfase al apretar el boton ingresar.

Un saludo

[childres12]

hola buen dia creo no fui muy explicativo envió un nuevo archivo espero se entienda, de antemano muchas gracias y el archivo anterior que me enviaste si me sirve pero para otra parte solo me puedes decir como decido a partir de que celda me haga esa funcion (digamos que la quiero a partir de la celda A35)

saludos y buen dia

MI INVENTARIO V2.xls

[joshua]

Saludos.

Prueba con la siguiente macro, cualquier duda comentas.

[COLOR="#0000FF"]Sub pasar_datos()

Dim valor As Range

Application.ScreenUpdating = False

hoja = ActiveSheet.Name

With Sheets("INTERFASE")

.Activate

finInter = .Range("B5").End(xlDown).Row

For x = 6 To finInter

Set valor = Sheets("BODEGA1").Range("C:C") _

.Find(What:=Cells(x, 3), LookAt:=xlWhole)

If Not valor Is Nothing Then

If valor = .Cells(x, 3) And valor.Offset(, 1) = .Cells(x, 4) Then

.Cells(x, 5).Resize(, 14).Copy Destination:=valor.Offset(, 2)

.Cells(x, 5).Resize(, 14).ClearContents

End If

End If

Next

End With

Sheets(hoja).Activate

Application.ScreenUpdating = True

End Sub

[/COLOR][/CODE]

Atte.

joshua

[alucard2011]

Buena solucion joshua y de la pregunta childres 12 te explico el codigo

U = Sheets("bodega").Cells(Rows.Count, "b").End(xlUp).Row 'busca la ultima celda vacia en la hoja bodega columna "b" de arriba a abajo

For FILA = 1 To 20                                             'el numero de filas que debe tomar en cuenta AQUI DICE DE 1 A 20 FILA puede copiar

If Cells(2 + FILA, "b") = "" Then Exit Sub                    'coordenada donde inicia 2 fila y EN COLUMNA B

Sheets("bodega").Cells(U + FILA, "B") = Cells(2 + FILA, "A").Value   'en cells(2+fila,"A")  el 2 es la fila donde estas iniciando a copiar los datos[/CODE]

espero te sirva saludos

[childres12]

de antemano muchas gracias joshua y alucard2011 yo checo ambos codigo saludos y suerte

[childres12]

Que tal amigo joshua tu macro funciona bien pero tengo detalles no me copia el valor si no es A(PASILLO) ,1,INFINITO (POSICION) 1(NIVEL) lo que me di cuentas es de que solo me pega conforme los numeros de la posicio y eh intente cambiarla en el range de c:c a b:d pero no me funciono no se si tenga solucion esto que me busque exactamente los valores proporcionadon en b,c,d (de ser posible solo en 650 filas ) como podras ver fue el unico cambio que hize de antemano gracias

Codigo:

Sub pasar_datos()Dim valor As RangeApplication.ScreenUpdating = Falsehoja = ActiveSheet.NameWith Sheets("INTERFASE").ActivatefinInter = .Range("B5").End(xlDown).RowFor x = 6 To finInterSet valor = Sheets("BODEGA1").Range("B:D") _.Find(What:=Cells(x, 3), LookAt:=xlWhole)If Not valor Is Nothing ThenIf valor = .Cells(x, 3) And valor.Offset(, 1) = .Cells(x, 4) Then.Cells(x, 5).Resize(, 14).Copy Destination:=valor.Offset(, 2).Cells(x, 5).Resize(, 14).ClearContentsEnd IfEnd IfNextEnd WithSheets(hoja).ActivateApplication.ScreenUpdating = TrueEnd Sub

[joshua]

Saludos.

Ya que los datos de las columnas seran variables, las uniremos es decir concatenarlas en la columna S, bueno es una de las formas más sencillas.

Sub pasar_datos()
Dim Valor As Range
Application.ScreenUpdating = False
hoja = ActiveSheet.Name
With Sheets("BODEGA1")
.Activate
finBode = .Range("A5").End(xlDown).Row
For x = 6 To finBode
Cells(x, 19) = Cells(x, 2) & Cells(x, 3) & Cells(x, 4)
Next
End With
With Sheets("INTERFASE")
.Activate
finInter = .Range("A5").End(xlDown).Row
For x = 6 To finInter
dato = Cells(x, 2) & Cells(x, 3) & Cells(x, 4)
Set Valor = Sheets("BODEGA1").Range("S:S") _
.Find(What:=dato, LookAt:=xlWhole)
If Not Valor Is Nothing Then
.Cells(x, 5).Resize(, 14).Copy Destination:=Valor.Offset(, -14)
.Cells(x, 5).Resize(, 14).ClearContents
End If
Next
End With
Sheets("BODEGA1").Range("S6:S" & finBode).ClearContents
Sheets(hoja).Activate
Application.ScreenUpdating = True
End Sub[/PHP]

Atte.

joshua

[childres12]

joshua ya probe pero no me funciona me deja todo en blanco el anterior funcionaba de maravillas solo por el detalle que no me respetaba el cambio de letra y numero en las celdas B y D disculpa tantas molestias o al menos que el codigo que me das se aplique diferente de antemamo gracias espero me puedas ayudar con mi duda

saludos

- - - - - Mensaje combinado - - - - -

joshua ya probe este codigo pero no me da los resulatado que espero de hecho el primero me gusto mucho solo que no me respetaba los que cambiaba en las columna B y D al menos que este nuevo codigo se aplique diferente de antemano agradesci tu ayuda

saludos

[joshua]

Saludos.

A mi me funciona bien, pregunto estas usando la misma estructura que el libro que subiste, o sea el libro "MI INVENTARIO V2.xls", en base a este libro esta elaborada la macro, si no es asi adjunta el libro que estas utilizando por supuesto que con datos ficticios.

Atte.

joshua

[childres12]

Ok joshua te adjunto el archivo que estoy utilizando espero que le entiendas de antemano gracias saludos, nota :los valores marcados en guinda o rojo obscuro algunos son reales el resto es ficticion

MI INVENTARIO V3.xls

[joshua]

Saludos.

Pruebala y comentas.

Sub pasar_datos()
Dim Valor As Range
Application.ScreenUpdating = False
hoja = ActiveSheet.Name
veriDatos = Application.CountA _
(Sheets("INTERFASE1").Range("E2:E40"))
If veriDatos = 0 Then: MsgBox "No hay datos que pasar": Exit Sub
With Sheets("BODEGA")
.Activate
For x = 4 To 655
Cells(x, 19) = Cells(x, 2) & Cells(x, 3) & Cells(x, 4)
Next
End With
With Sheets("INTERFASE1")
.Activate
For x = 2 To 40
dato = Cells(x, 2) & Cells(x, 3) & Cells(x, 4)
Set Valor = Sheets("BODEGA").Range("S4:S655") _
.Find(What:=dato, LookAt:=xlWhole)
If Not Valor Is Nothing Then
.Cells(x, 5).Resize(, 14).Copy
Valor.Offset(, -14).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
.Cells(x, 5).Resize(, 14).ClearContents
End If
Next
End With
Sheets(hoja).Activate
Application.ScreenUpdating = True
End Sub[/PHP]

Atte.

joshua

[childres12]

muchas gracias joshua me funciono perfecto justo lo que necesito solo mi ultima duda necesito ingresar 2 datos mas osea ocupar la letra s y t y para que lo de concatenar me quede en la u lo ultimo lo prometo saludo

[joshua]

Saludos.

Esta seria la macro modificada, prueba y comentas.

Sub pasar_datos()

Dim Valor As Range

Application.ScreenUpdating = False

hoja = ActiveSheet.Name

veriDatos = Application.CountA _

(Sheets("INTERFASE1").Range("E2:E40"))

If veriDatos = 0 Then: MsgBox "No hay datos que pasar": Exit Sub

With Sheets("BODEGA")

.Activate

For x = 4 To 655

Cells(x, 21) = Cells(x, 2) & Cells(x, 3) & Cells(x, 4)

Next

End With

With Sheets("INTERFASE1")

.Activate

For x = 2 To 40

dato = Cells(x, 2) & Cells(x, 3) & Cells(x, 4)

Set Valor = Sheets("BODEGA").Range("U4:U655") _

.Find(What:=dato, LookAt:=xlWhole)

If Not Valor Is Nothing Then

[COLOR="#0000FF"].Cells(x, 5).Resize(, 16).Copy[/COLOR]

Valor.Offset(, -16).PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

[COLOR="#0000FF"].Cells(x, 5).Resize(, 16).ClearContents[/COLOR]

End If

Next

End With

Sheets(hoja).Activate

Application.ScreenUpdating = True

End Sub[/CODE]

Atte.

joshua

[childres12]

estimado joshua de antemano una disculpa por no comentar antes tu macro funciona perfecto solo que los dos datos mas que necesito ingresar de igual forma quiero que me los jale desde interfase1 y solo me jala los datos que ingreso pero asta la letra R los que ingrese en la S y T no los jala espero me puedas aclaras como corregir ese punto de antemano muhas gracias saludos

[joshua]

Saludos.

En la ultima macro que te adjunte esta hecha la correcion (en azul), pruebala y comentas.

Atte.

joshua

[childres12]

muchas gracias joshua justo los resultados que esperaba con esto doy por solucionado mi problema gracias por el tiempo que se tomaron en contestar mis preguntas

[digitalboy]

Charros! y todo esto se hubiera echo mas fácilmente y quizás con menos programación si se hubiera utilizado Access. Algún día ampliare mi dominio del mismo para resolver este tipo de problemas desde otra perspectiva!

[childres12]

si lo de accces suena bien pero mi reto es hacerlo en excel

gracias a todos lo que me ayudaron de verdad gracias

saludos

solucionado