Como Copiar y Eliminar Item al Pasar de Listbox a Otro Listbox con Doble Click y Vicerversa

En este post se mostrará Como Pasar Registros de Un Listbox a Otro Listbox Eliminar Item y Viceversa Haciendo Doble Click; es una variante de lo realizado al presionar Enter y se expuso en Como Copiar y Eliminar Item al Pasar de Listbox a Otro y Viceversa Listbox con Enter.

La macro permite al hacer doble click en el Listbox pasar los datos a otro listbox, eliminando los datos del primer listbox; en el segundo listbox se puede hacer lo mismo es decir presionando doble click se pasa al primer listbox eliminando los registros del del segundo listbox.

Si te estás iniciando en la operación de Excel o requieres afirmar conocimientos, recomiendo leer un excelente libro sobre Excel que te ayudará operar las planillas u hojas de cálculo, haz click acá, si quieres aprender sobre Excel, en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet.

Suscribe a nuestro canal para que YouTube te avise cuando se suba nuevo contenido al canal, en el vídeo encontrarás una explicación gráfica y detallada del ejemplo que se muestra en este post.

if (payload.eventType == ‘subscribe’) {
// Add code to handle subscribe event.
} else if (payload.eventType == ‘unsubscribe’) {
// Add code to handle unsubscribe event.
}
if (window.console) { // for debugging only
window.console.log(‘YT event: ‘, payload);
}
}

Se sugiere descargar el ejemplo de esta forma será más fácil entender el ejemplo, al presionar el botón que se encuentra en la hoja de Excel del libro que contiene el ejemplo, se muestra un formulario con dos listbox, el Listbox1 con fondo color Rosa y el Listbox2 con fondo color Blanco.

Si se hace doble click sobre un ítem seleccionado en el primer listbox, se pasarán los datos al segundo Listbox eliminando los registros del Listbox con fondo Rosa, en el caso que no hayamos equivocado o simplemente, porque no se requiera que ese ítem este en el Listbox2, se puede hacer doble click en este Listbox2 pasar el ítem nuevamente el Listbox1 y eliminar el registro del Listbox con fondo Blanco.

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

Quizá sea de utilidad también

Como agregar un botón maximizar minimizar a un formulario de Excel

Como sumar celdas de un mismo color

Como enviar mail con outlook adjuntando archivo PDF

El código se debe escribir en el evento doble click del Listbox1 y Listbox2, obviamente haciendo referencia a cada control correspondiente, básicamente el código es el siguiente:

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

On Error Resume Next

Set a = UserForm1.ListBox1

Set b = UserForm1.ListBox2

fila = UserForm1.ListBox1.ListIndex

El códigos anteriores permiten crear un objeto con el Listbox1 y Listbox2 y determinar la fila del Listbox con el ítem seleccionado.

b.AddItem a.List(fila, 0)

b.List(b.ListCount – 1, 1) = a.List(fila, 1)

b.List(b.ListCount – 1, 2) = a.List(fila, 2)

b.List(b.ListCount – 1, 3) = a.List(fila, 3)

a.RemoveItem a.ListIndex

Los códigos anteriores, permiten pasar los datos de un Listbox a otro Listbox y con la última línea de código remover o borrar los registros del Listbox, lo anteriormente especificado se debe realizar con el Listbox2 en su evento doble click.

La descarga del ejemplo se realiza desde el final del post y seguidamente se muestra el código del ejemplo Como Copiar y Eliminar Registro al Pasar de un Listbox a Otro con Doble Click.

Código que se inserta en un Formulario de Excel

‘******https://macrosenexcel.com https://youtube.com/programarexcel*
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
Set a = UserForm1.ListBox1
Set b = UserForm1.ListBox2
fila = UserForm1.ListBox1.ListIndex
b.AddItem a.List(fila, 0)
b.List(b.ListCount – 1, 1) = a.List(fila, 1)
b.List(b.ListCount – 1, 2) = a.List(fila, 2)
b.List(b.ListCount – 1, 3) = a.List(fila, 3)
a.RemoveItem a.ListIndex
End Sub
Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error Resume Next
Set aa = UserForm1.ListBox1
Set bb = UserForm1.ListBox2
fila = bb.ListIndex
aa.AddItem bb.List(fila, 0)
aa.List(aa.ListCount – 1, 1) = bb.List(fila, 1)
aa.List(aa.ListCount – 1, 2) = bb.List(fila, 2)
aa.List(aa.ListCount – 1, 3) = bb.List(fila, 3)
bb.RemoveItem bb.ListIndex
End Sub
Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets(«Hoja1»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = «» Then
‘Me.ListBox1.List() = b.Range(«A2:H» & uf).Value
Me.ListBox1.RowSource = «Hoja1!A2:D» & uf
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1.Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
strg = b.Cells(i, 1).Value
If UCase(strg) Like «» & UCase(TextBox1.Value) & «» Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = b.Cells(i, 4)
End If
Next i
Me.ListBox1.ColumnWidths = «20 pt;90pt;80 pt;80 pt»
End Sub
Private Sub TextBox2_Change()
On Error Resume Next
Set b = Sheets(«Hoja1»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
If Trim(TextBox2.Value) = «» Then
‘Me.ListBox1.List() = b.Range(«A2:H» & uf).Value
Me.ListBox1.RowSource = «Hoja1!A2:H» & uf
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1.Clear
Me.ListBox1.RowSource = Clear
For i = 2 To uf
strg = b.Cells(i, 2).Value
If UCase(strg) Like «» & UCase(TextBox2.Value) & «» Then
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = b.Cells(i, 4)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 6) = b.Cells(i, 7)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 7) = b.Cells(i, 8)
End If
Next i
Me.ListBox1.ColumnWidths = «20 pt;90pt;80 pt;80 pt»
End Sub
Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets(«Hoja2»)
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, «$») + 1, InStr(2, uc, «$») – 2)
With Me.ListBox1
.ColumnCount = 4
.ColumnWidths = «20 pt;90pt;80 pt;80 pt»
‘.RowSource = «Hoja2!A2:» & wc & uf
End With
With Me.ListBox2
.ColumnCount = 4
.ColumnWidths = «25 pt;90pt;60 pt;60 pt»
End With
uf = b.Range(«A» & Rows.Count).End(xlUp).Row
For i = 2 To uf
Me.ListBox1.AddItem b.Cells(i, 1)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount – 1, 3) = b.Cells(i, 4)
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Código que se inserta en un módulo

‘******https://macrosenexcel.com https://youtube.com/programarexcel*
Sub muestra1()
UserForm1.Show
End Sub

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.

If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends

‘**************https://macrosenexcel.com **** https://youtube.com/programarexcel*********Sub muestra1() UserForm1.Show End Sub

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛

‘******https://macrosenexcel.com https://youtube.com/programarexcel*
Sub muestra1()
UserForm1.Show
End Sub