Copiar valor de un cuadro de lista a otra celda
Que tal expertos.
Una vez más les saludo con mucho gusto agradeciéndoles su apoyo brindado anterior mente, esperando puedan ayudarme en lo siguiente:
Tengo en un libro una hoja llamada "Enero", en la cual tengo una tabla con algunos registros, los cuales cuentan entre uno de sus campos con un Cuadro de Lista (con validación de datos) que permite seleccionar A, B y C.
En la misma hoja "Enero" inserté un botón que corta y envía los registros con campos B y C a otra hoja llamada "Zona". Pero el problema es que los envía y pega con el Cuadro de lista. El requerimiento es que pegue únicamente dichos registros sin el Cuadro de Lista.
He buscado entre código VBA sin tener éxito.
De antemano les agradezco quedando atento a sus comentarios.
Una vez más les saludo con mucho gusto agradeciéndoles su apoyo brindado anterior mente, esperando puedan ayudarme en lo siguiente:
Tengo en un libro una hoja llamada "Enero", en la cual tengo una tabla con algunos registros, los cuales cuentan entre uno de sus campos con un Cuadro de Lista (con validación de datos) que permite seleccionar A, B y C.
En la misma hoja "Enero" inserté un botón que corta y envía los registros con campos B y C a otra hoja llamada "Zona". Pero el problema es que los envía y pega con el Cuadro de lista. El requerimiento es que pegue únicamente dichos registros sin el Cuadro de Lista.
He buscado entre código VBA sin tener éxito.
De antemano les agradezco quedando atento a sus comentarios.
1 Respuesta
Respuesta de calvuch
1
Debes pegar la selección de tus datos con la forma pegado especial solo texto:
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Inserta estas lineas en reemplazo por la actual que tienes que pega los datos ( generalmente después de selecinar el rango y realizar el comando Copy)
Bye
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Inserta estas lineas en reemplazo por la actual que tienes que pega los datos ( generalmente después de selecinar el rango y realizar el comando Copy)
Bye
Que tal calvuch, muchas gracias por apoyarme nuevamente.
Fíjate que ya hice lo que dices pero me marca error.
El problema real lo tengo de esta manera:
Tengo una hoja llamada "Obras", en la cual tengo una tabla con diferentes campos, la cual tiene un campo Status que en sus registros tiene un cuadro combinado, en donde el usuario selecciona Activa, Terminada o Cancelada. Y en la misma hoja tengo un botón que corta y pega los registros con Status Terminada y Cancelada a otra hoja llamada "ObTem". Solo deja los registros con Status Activa en la Hoja Obras.
Todo esto lo hace sin problema, pero pega los registros con el cuadro de lista y él requerimiento es que pegue el valor únicamente en ese campo.
Este es el código actual que hace el cortado y pegado (De hecho tú me ayudaste con esto):
If Range("F" & i).Value = "Terminada" Or Range("F" & i).Value = "Cancelada" Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Cut
Sheets("ObTerm").Select
Sheets("ObTerm").Rows(Sheets("ObTerm").Range("A65536").Value + 1 & ":" & Sheets("ObTerm").Range("A65536").Value + 1).Select
ActiveSheet.Paste
Sheets("Obras").Select
End If
Ahora utilizo la las líneas con la forma de pegado especial de solo texto y me queda así:
If Range("F" & i).Value = "Terminada" Or Range("F" & i).Value = "Cancelada" Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Cut
Sheets("ObTerm").Select
Sheets("ObTerm").Rows(Sheets("ObTerm").Range("A65536").Value + 1 & ":" & Sheets("ObTerm").Range("A65536").Value + 1).Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Obras").Select
End If
Me marca error cuando el estatus de los registros es Terminada o Cancelada, pero cuando el status es Activa no me marca error, puesto que no hace la operación de cortar y copiar.
De antemano muchas gracias y quedo atento a tus comentarios
Fíjate que ya hice lo que dices pero me marca error.
El problema real lo tengo de esta manera:
Tengo una hoja llamada "Obras", en la cual tengo una tabla con diferentes campos, la cual tiene un campo Status que en sus registros tiene un cuadro combinado, en donde el usuario selecciona Activa, Terminada o Cancelada. Y en la misma hoja tengo un botón que corta y pega los registros con Status Terminada y Cancelada a otra hoja llamada "ObTem". Solo deja los registros con Status Activa en la Hoja Obras.
Todo esto lo hace sin problema, pero pega los registros con el cuadro de lista y él requerimiento es que pegue el valor únicamente en ese campo.
Este es el código actual que hace el cortado y pegado (De hecho tú me ayudaste con esto):
If Range("F" & i).Value = "Terminada" Or Range("F" & i).Value = "Cancelada" Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Cut
Sheets("ObTerm").Select
Sheets("ObTerm").Rows(Sheets("ObTerm").Range("A65536").Value + 1 & ":" & Sheets("ObTerm").Range("A65536").Value + 1).Select
ActiveSheet.Paste
Sheets("Obras").Select
End If
Ahora utilizo la las líneas con la forma de pegado especial de solo texto y me queda así:
If Range("F" & i).Value = "Terminada" Or Range("F" & i).Value = "Cancelada" Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Cut
Sheets("ObTerm").Select
Sheets("ObTerm").Rows(Sheets("ObTerm").Range("A65536").Value + 1 & ":" & Sheets("ObTerm").Range("A65536").Value + 1).Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Obras").Select
End If
Me marca error cuando el estatus de los registros es Terminada o Cancelada, pero cuando el status es Activa no me marca error, puesto que no hace la operación de cortar y copiar.
De antemano muchas gracias y quedo atento a tus comentarios
Ha, sorry, verdad que tu decías que "cortas" el registro, bien, en caso de cortar un registro, pues no hay opción de pegado especial, pasas el contenido completo del origen ( formato, valores, etc). Si decides copiar en vez de cortar, allí te servirá el pegado especial.
Pero lo que puedes hacer es lo siguiente
1 copiar el dato
2 selecinar la hoja de destino
3 pegar el dato
4 volver a la hoja origen
5 eliminar la fila completa que ya copiaste
en tu macro seria:
If Range("F" & i).Value = "Terminada" Or Range("F" & i).Value = "Cancelada" Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Copy
Sheets("ObTerm").Select
Sheets("ObTerm").Rows(Sheets("ObTerm").Range("A65536").Value + 1 & ":" & Sheets("ObTerm").Range("A65536").Value + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Obras").Select
Selection.Delete Shift:=xlUp
End if
Prueba a ver que tal
Pero lo que puedes hacer es lo siguiente
1 copiar el dato
2 selecinar la hoja de destino
3 pegar el dato
4 volver a la hoja origen
5 eliminar la fila completa que ya copiaste
en tu macro seria:
If Range("F" & i).Value = "Terminada" Or Range("F" & i).Value = "Cancelada" Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Copy
Sheets("ObTerm").Select
Sheets("ObTerm").Rows(Sheets("ObTerm").Range("A65536").Value + 1 & ":" & Sheets("ObTerm").Range("A65536").Value + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Obras").Select
Selection.Delete Shift:=xlUp
End if
Prueba a ver que tal
Saludos calvuch.
Mira que ha funcionado de maravilla, ahora los cuadros combinados se han quedado en su origen.
Sólo dos detallitos:
Ente los registros que se van a la hoja "ObTerm" unos son fechas, y a la hora de pegarse estos pierden su formato de fecha.
Y fíjate que después de pegar los registros en la hoja "ObTerm", sí elimino algunos eliminando filas, a la hora de pegar más, estos nuevos se pegan desfasados el numero de filas que elimine. Es decir, ya no se insertan en la última fila vacía de la hoja "ObTerm".
¿Sabrás a que se debe?
Muchas gracias de antemano.
Mira que ha funcionado de maravilla, ahora los cuadros combinados se han quedado en su origen.
Sólo dos detallitos:
Ente los registros que se van a la hoja "ObTerm" unos son fechas, y a la hora de pegarse estos pierden su formato de fecha.
Y fíjate que después de pegar los registros en la hoja "ObTerm", sí elimino algunos eliminando filas, a la hora de pegar más, estos nuevos se pegan desfasados el numero de filas que elimine. Es decir, ya no se insertan en la última fila vacía de la hoja "ObTerm".
¿Sabrás a que se debe?
Muchas gracias de antemano.
Veamos en cuanto al formato de fechas, es simple ve a la hoja ObTerm y a la columna en donde debe ir fecha, pues dale el formato de fecha, cada vez que copies un dato a esa columna si ya tiene el formato indicado para recibir el dato, pues lo mostrara como debe
en cuanto a que se pegue en forma secuencial (última fila) he modificado el macro
debes declarar la variable g como long Dim g As Long
el macro quedaría así:
Sheets("ObTerm").Select
[a65536].Formula = "=COUNTA(R[-65535]C:R[-1]C)"
g = [a65536].Value + 1
Sheets("Obras").Select
If Range("F" & i).Value = "Terminada" Or Range("F" & i).Value = "Cancelada" Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Copy
Sheets("ObTerm").Select
Cells(g, 1).Select
Sheets("ObTerm").Rows(Sheets("ObTerm").Range("A65536").Value + 1 & ":" & Sheets("ObTerm").Range("A65536").Value + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Obras").Select
Selection.Delete Shift:=xlUp
Te sugiero que una evz que hayas copiado, los datos que necesitas ( haber corrido el macro), luego elimines las filas de la hoja Obras que ya no te sirvan,
bye
en cuanto a que se pegue en forma secuencial (última fila) he modificado el macro
debes declarar la variable g como long Dim g As Long
el macro quedaría así:
Sheets("ObTerm").Select
[a65536].Formula = "=COUNTA(R[-65535]C:R[-1]C)"
g = [a65536].Value + 1
Sheets("Obras").Select
If Range("F" & i).Value = "Terminada" Or Range("F" & i).Value = "Cancelada" Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Copy
Sheets("ObTerm").Select
Cells(g, 1).Select
Sheets("ObTerm").Rows(Sheets("ObTerm").Range("A65536").Value + 1 & ":" & Sheets("ObTerm").Range("A65536").Value + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Obras").Select
Selection.Delete Shift:=xlUp
Te sugiero que una evz que hayas copiado, los datos que necesitas ( haber corrido el macro), luego elimines las filas de la hoja Obras que ya no te sirvan,
bye
Que tal.
Por favor una disculpa. Fíjate que me marca error en Cells(g, 1). Select cuando coloco los cambios que me sugeriste.
Te muestro mi código actual. Es muy posible que lo esté poniendo mal o que esté iterando código.
Private Sub CommandButton1_Click()
Dim i As Long
Dim N As Long
Sheets("Obras").Range("A65536").Formula = "=COUNTA(R[-65535]C:R[-1]C)"
Sheets("ObTerm").Range("A65536").Formula = "=COUNTA(R[-65535]C:R[-1]C)"
If Sheets("Obras").Range("A65536") = 0 Then Exit Sub
N = Sheets("Obras").Range("A65536")
Sheets("Obras").Range("A65536").Clear
Sheets("Obras").Select
Sheets("Obras").Range("A" & N + 1).Value = "stp"
For i = 2 To N + 1
If Range("F" & i).Value = "Terminada" Or Range("F" & i).Value = "Cancelada" Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Copy
Sheets("ObTerm").Select
Sheets("ObTerm").Rows(Sheets("ObTerm").Range("A65536").Value + 1 & ":" & Sheets("ObTerm").Range("A65536").Value + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Obras").Select
Selection.Delete Shift:=xlUp
End If
DoEvents
Next
i = 0
' ELIMINAR
Sheets("Obras").Select
For i = 2 To (N + 1)
If Range("A" & i).Value = "stp" Then Exit For
If Range("A" & i).Value = Empty Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Delete Shift:=xlUp
If Range("A" & i).Value = Empty Then Sheets("Obras").Rows(i & ":" & i).Select: Selection.Delete Shift:=xlUp
Else
If Range("A" & (i - 1)).Value = Empty Then Sheets("Obras").Rows((i - 1) & ":" & (i - 1)).Select: Selection.Delete Shift:=xlUp
End If
DoEvents
Next
Range("A" & i).Clear
Range("A2").Select
MsgBox "Terminado", vbInformation
End Sub
Quedo atento a tus comentarios.
Por favor una disculpa. Fíjate que me marca error en Cells(g, 1). Select cuando coloco los cambios que me sugeriste.
Te muestro mi código actual. Es muy posible que lo esté poniendo mal o que esté iterando código.
Private Sub CommandButton1_Click()
Dim i As Long
Dim N As Long
Sheets("Obras").Range("A65536").Formula = "=COUNTA(R[-65535]C:R[-1]C)"
Sheets("ObTerm").Range("A65536").Formula = "=COUNTA(R[-65535]C:R[-1]C)"
If Sheets("Obras").Range("A65536") = 0 Then Exit Sub
N = Sheets("Obras").Range("A65536")
Sheets("Obras").Range("A65536").Clear
Sheets("Obras").Select
Sheets("Obras").Range("A" & N + 1).Value = "stp"
For i = 2 To N + 1
If Range("F" & i).Value = "Terminada" Or Range("F" & i).Value = "Cancelada" Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Copy
Sheets("ObTerm").Select
Sheets("ObTerm").Rows(Sheets("ObTerm").Range("A65536").Value + 1 & ":" & Sheets("ObTerm").Range("A65536").Value + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Obras").Select
Selection.Delete Shift:=xlUp
End If
DoEvents
Next
i = 0
' ELIMINAR
Sheets("Obras").Select
For i = 2 To (N + 1)
If Range("A" & i).Value = "stp" Then Exit For
If Range("A" & i).Value = Empty Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Delete Shift:=xlUp
If Range("A" & i).Value = Empty Then Sheets("Obras").Rows(i & ":" & i).Select: Selection.Delete Shift:=xlUp
Else
If Range("A" & (i - 1)).Value = Empty Then Sheets("Obras").Rows((i - 1) & ":" & (i - 1)).Select: Selection.Delete Shift:=xlUp
End If
DoEvents
Next
Range("A" & i).Clear
Range("A2").Select
MsgBox "Terminado", vbInformation
End Sub
Quedo atento a tus comentarios.
¿Qué error te da?... ( descripción y numero )
Reescribí el script
Prueba con esto en el botón
Private Sub CommandButton1_Click()
Dim i As Long
Dim g As Long
Dim st As Long
Application.ScreenUpdating = False
Sheets("Obras").Select
[a65536].Formula = "=COUNTA(R[-65535]C:R[-1]C)"
st = [a65536].Value
[a65536].Clear
Sheets("ObTerm").Select
[a65536].Formula = "=COUNTA(R[-65535]C:R[-1]C)"
g = [a65536].Value + 1
Sheets("Obras").Select
For i = 2 To st
If UCase(Range("F" & i).Value) = "TERMINADA" Or UCase(Range("F" & i).Value) = "CANCELADA" Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Copy
Sheets("ObTerm").Select
Cells(g, 1).Select
Sheets("ObTerm").Rows(Sheets("ObTerm").Range("A65536").Value + 1 & ":" & Sheets("ObTerm").Range("A65536").Value + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Obras").Select
Selection.Delete Shift:=xlUp
If UCase(Range("F" & i).Value) = "TERMINADA" Or UCase(Range("F" & i).Value) = "CANCELADA" Then i = (i - 1)
End If
DoEvents
Next
Application.ScreenUpdating = True
[a2].Select
MsgBox "TERMINADO", vbInformation
End Sub
Si no va con esto LE PRENDO FUEGO A MI TECLADO!
Si tienes algún problema con este ejemplo enviame tu mail y te adjunto la planilla de prueba
bye
Prueba con esto en el botón
Private Sub CommandButton1_Click()
Dim i As Long
Dim g As Long
Dim st As Long
Application.ScreenUpdating = False
Sheets("Obras").Select
[a65536].Formula = "=COUNTA(R[-65535]C:R[-1]C)"
st = [a65536].Value
[a65536].Clear
Sheets("ObTerm").Select
[a65536].Formula = "=COUNTA(R[-65535]C:R[-1]C)"
g = [a65536].Value + 1
Sheets("Obras").Select
For i = 2 To st
If UCase(Range("F" & i).Value) = "TERMINADA" Or UCase(Range("F" & i).Value) = "CANCELADA" Then
Sheets("Obras").Rows(i & ":" & i).Select
Selection.Copy
Sheets("ObTerm").Select
Cells(g, 1).Select
Sheets("ObTerm").Rows(Sheets("ObTerm").Range("A65536").Value + 1 & ":" & Sheets("ObTerm").Range("A65536").Value + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("Obras").Select
Selection.Delete Shift:=xlUp
If UCase(Range("F" & i).Value) = "TERMINADA" Or UCase(Range("F" & i).Value) = "CANCELADA" Then i = (i - 1)
End If
DoEvents
Next
Application.ScreenUpdating = True
[a2].Select
MsgBox "TERMINADO", vbInformation
End Sub
Si no va con esto LE PRENDO FUEGO A MI TECLADO!
Si tienes algún problema con este ejemplo enviame tu mail y te adjunto la planilla de prueba
bye
