Como Pasar datos listbox multiselect a otro listbox con enter





La macro del presente post muestra como pasar datos de un listbox multiselect a otro listbox al presionar Enter, anteriormente se han publicado muchos ejemplos sobre el manejo de listbox de Excel, entre ellos: como pasar datos con doble click desde Listbox a una hoja de Excel, listbox de varias columnas copia item seleccionado a celdas de Excel y una infinidad de ejemplos de macros con listbox cuyos tutoriales y descarga se puede hacer desde este link.

Aporta por favor para sostener el sitio si está dentro de tus posibilidades, desde ya muchas gracias, desde el final del post se puede descargar el ejemplo en forma gratuita sin ninguna restricción, el código se puede adaptar a cada necesidad.

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.

  

El vídeo verás la macro en acción con una explicación más detallada de su codificación y funcionamiento, recomiendo observar para una más fácil comprensión de la macro; suscribe a nuestra web desde la parte superior derecha de la página ingresando tu mail y a nuestro canal de You Tube para recibir en tu correo vídeos explicativos sobre macros interesantes, como  por ejemplo Recorre fila buscando y comparando datos de dos columnas en hojas distintasbuscar en listbox mientras escribes en textbox, como crear una factura o sale invoice y grabar guardar PDF XLS y enviar por mail, trabajando con filas, celdas, columnas, rangos y muchos ejemplos más.







  


La macro que se muestra en este ejemplo permite como ya se dijo pasar o copiar datos de un lisbox multiselect a otro lisbox, en este caso la acción mencionada se realiza cuando se presiona entes, es decir que seleccionados los items que se necesitar pasar al otro listbox, luego presionando Enter se copian los datos seleccionados en el listbox multiselect al otro listbox.

El ejemplo incluye muchas más cosas que ya fueron explicadas en otros ejemplos como, buscar mientras se escribe un textbox y cargar los datos encontrados en un listbox, todo ello a medida o en forma simultánea con la escritura de caracteres, en otras palabras va encontrando todas las coincidencia que existan en la base de datos con los caracteres escritos en el textbox, una vez encontrados los va cargando en el listbox, todo en milisengundos por lo que el resultado se ve inmediatamente en el listbox.

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizá sea de utilidad también

Como enviar mail desde Excel adjuntando PDF


Como enviar mail con archivo Excel y PDF mediante Outlook con Excel

Formulario de VBA para insertar datos

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



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

Con el siguiente código se puede detectar que se ha presionado la tecla Enter, luego de ello proceder a copiar los datos del listbox multiselect al otro listbox.

If KeyAscii = 13 Then

Luego la macro hace un bucle desde la primera a la última fila del listbox en busca de datos seleccionados, acá se debe recordar que en los listbox las filas empiezan en la número cero, es decir la fila cero sería la primer fila del listbox, con el siguiente código se determinar si un item está seleccionado:

If Me.ListBox1.Selected(X) = True Then

En caso que el item este seleccionado se copia toda la fila del listbox al otro listbox donde se requeire copiar los datos para ello se utilizar:

Me.ListBox2.List(ListBox2.ListCount - 1, 1) = ListBox1.List(fila, 1)
ListBox2.List(ListBox2.ListCount - 1, 2) = ListBox1.List(fila, 2)
...

En definitiva el código establece que se copie la fila "X", que es la que recorre el bucle en ese momento, desde el listbox1, que en este caso es multiselect al listbox 2, recuerda que el ejemplo denominado como pasar datos de listbox multiselect o otro listbox con Enter, es mucho más fácil de comprender si se descarga el archivo desde el final del post, es GRATIS.


Código que se inserta en un Formulario

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
On Error Resume Next
If KeyAscii = 13 Then
For X = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(X) = True Then
fila = X
Me.ListBox2.AddItem ListBox1.List(fila, 0)
Me.ListBox2.List(ListBox2.ListCount - 1, 1) = ListBox1.List(fila, 1)
ListBox2.List(ListBox2.ListCount - 1, 2) = ListBox1.List(fila, 2)
ListBox2.List(ListBox2.ListCount - 1, 3) = ListBox1.List(fila, 3)
ListBox2.List(ListBox2.ListCount - 1, 4) = ListBox1.List(fila, 4)
ListBox2.List(ListBox2.ListCount - 1, 5) = ListBox1.List(fila, 5)
ListBox2.List(ListBox2.ListCount - 1, 6) = ListBox1.List(fila, 6)
ListBox2.List(ListBox2.ListCount - 1, 7) = ListBox1.List(fila, 7)
End If
Next X

For j = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(j) = True Then Me.ListBox1.Selected(j) = False
Next j
End If
End Sub


Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("Hoja2")
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 = "Hoja2!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, 3).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)
       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;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"

End Sub
Private Sub TextBox2_Change()
On Error Resume Next
Set b = Sheets("Hoja2")
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 = "Hoja2!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, 4).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;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
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 = 8
    .ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
    .RowSource = "Hoja2!A2:" & wc & uf
End With
With Me.ListBox2
    .ColumnCount = 8
    .ColumnWidths = "20 pt;70 pt;180 pt;80 pt;60 pt;60 pt;60 pt;60pt"
End With
Set a = UserForm1.ListBox1
For X = 1 To a.ListCount - 1
If a.Selected(X) = True Then a.Selected(X) = False
Next X

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error GoTo Fin
If CloseMode <> 1 Then Cancel = True
Fin:
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