Pasar datos listbox multiselect a distintas hoja Excel dependiendo de condición





Un suscriptor de nuestro canal de Youtube solicita ayuda respecto a una variante de un tutorial presentado anteriormente denominado como pasar datos de listbox multiselect a hoja de Excel, difiere el presente ejemplo con el mencionado anteriormente en que los datos seleccionados en el listbox se pasará a distintas hojas de Excel dependiendo de condición no a una sola hoja de Excel, ello es lo que da origen a la macro llamada como pasar datos de listbox multiselect a distintas hojas de Excel dependiendo de condición.

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 muestra el funcionamiento de la macro en forma visual lo que hará más fácil comprender el funcionamiento del ejemplo de macro presentado en este post; 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 macro de Excel que permite comprimir archivos con extensión ZIP, macro que recorre fila busca el dato y resalta la fila donde se encuentra, marcar celda cuando la sumatoria llegue a cierto valor y muchos ejemplos más.









  

Por favor considera aportar para sostener el sitio recuerda que todos los ejemplos son gratuitos, el fichero se puede descargar en forma totalmente gratuita desde el final del post, se solicita se comparta el post en las redes sociales, like si fue útil.

Al descargar el ejemplo se puede observar en el libro de Excel una vez abierto, dos botones, un botón muestra el formulario con el respectivo listbox y otro botón que borra los datos de las distintas hojas para poder ejecutar la macro una y otra vez sin acumular una gran cantidad de registros en la hoja, es algo opcional.

⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛⇛
Quizás interese también:

Pasar datos de listbox a hoja de Excel

Cargar datos en textbox y pasar a listbox

Como pasar datos de un listbox a otro listbox con doble click

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

Al presionar el botón que permite mostrar el formulario, se observa un userform con un listbox que al iniciar carga los datos de la base de datos que está en la Hoja2, el listbox es multiselect, esto significa que permite seleccionar varios ítem a la vez; también se puede observar en el userform dos botones, uno para salir y el otro para pasar los datos seleccionados en el listbox a la Hoja de Excel.

La macro contiene hojas con las marcas de productos "SEDAL", "ARCOR" y "BAGLEY", si en el listbox se seleccionan artículos con estas marcas se pasarán a la hoja correspondiente en caso que no coincidan con estás marcas, es decir sea cualquier otra marca de producto se guardan en la HOJA1.

La macro establece condiciones antes de pasar los datos del listbox a la hoja de Excel, esta es la diferencia con el ejemplo original que directamente pasaba lo seleccionado a la Hoja1.

El siguiente código es el que determina la condición que se debe cumplir para pasar los datos a una u otra hoja, en primer lugar se detecta cual es la marca del productos seleccionado en el listbox, en este caso se encuentra en la columna 3 del listbox (recuerden las columnas del listbox se empiezan a contar desde cero), una vez detectado cual es la marca del producto seleccionado en el listbox se apela a estructura Select Case (click en el link para saber mas sobre el uso de Select Case).

marsel = Me.ListBox1.List(x, 3)
Select Case marsel
Case Is = "arcor"
Marca = "Arcor"
Case Is = "sedal"
Marca = "Sedal"
Case Is = "bagley"
Marca = "Bagley"
End Select
        
If Marca = Empty Then Marca = "Hoja1"
Set a = Sheets(Marca)

Dependiendo de la marca del producto seleccionado se establece el nombre de la hoja, si la hoja no es igual a alguna de las tres marcas expuestas se otorga el nombre Hoja1; posteriormente a hace un objeto usando como nombre de hoja el de la marca seleccionada, el resto de la codificación es igual que el ejemplo como pasar datos de listbox multiselect a hoja de Excel por lo que si es necesario aprender sobre su funcionamiento recomiendo echarle un vistazo.

Recuerda que el ejemplo que denominado como pasar datos de listbox multiselect a distintas hojas de Excel dependiendo de condición se puede descargar desde el link del final, a continuación se expone toda la codificación que contiene el ejemplo y que se podrá observar al descargar el ejemplo y editar con el editor de Visual Basic Aplication. (VBA).

Código que se inserta en un módulo


Sub muestra1()
UserForm1.Show
End Sub
Sub borrar()

uf = Sheets("Hoja1").Range("A" & Rows.Count).End(xlUp).Row
If uf = 1 Then uf = 2
Sheets("Hoja1").Range("A2" & ":H" & uf).Clear

uf = Sheets("Arcor").Range("A" & Rows.Count).End(xlUp).Row
If uf = 1 Then uf = 2
Sheets("Arcor").Range("A2" & ":H" & uf).Clear

uf = Sheets("Sedal").Range("A" & Rows.Count).End(xlUp).Row
If uf = 1 Then uf = 2
Sheets("Sedal").Range("A2" & ":H" & uf).Clear

uf = Sheets("Bagley").Range("A" & Rows.Count).End(xlUp).Row
If uf = 1 Then uf = 2
Sheets("Bagley").Range("A2" & ":H" & uf).Clear
End Sub



Código que se inserta en un formulario

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub CommandButton2_Click()
Dim conta As Integer
On Error Resume Next
conta = 0
For x = 0 To Me.ListBox1.ListCount - 1
    If Me.ListBox1.Selected(x) = True Then
    conta = conta + 1
    End If
Next x
If conta = 0 Then
MsgBox "Debe seleccionar un item para copiar en hoja de Excel", vbInformation, "AVISO"
Exit Sub
End If
conta = 0

For x = 0 To Me.ListBox1.ListCount - 1
Marca = Empty
If Me.ListBox1.Selected(x) = True Then
marsel = Me.ListBox1.List(x, 3)
Select Case marsel
Case Is = "arcor"
Marca = "Arcor"
Case Is = "sedal"
Marca = "Sedal"
Case Is = "bagley"
Marca = "Bagley"
End Select
        
If Marca = Empty Then Marca = "Hoja1"
Set a = Sheets(Marca)
filaedit = a.Range("A" & Rows.Count).End(xlUp).Row + 1
          
a.Cells(filaedit, "A") = ListBox1.List(x, 0)
a.Cells(filaedit, "B") = ListBox1.List(x, 1)
a.Cells(filaedit, "C") = ListBox1.List(x, 2)
a.Cells(filaedit, "D") = ListBox1.List(x, 3)
a.Cells(filaedit, "E") = ListBox1.List(x, 4)
a.Cells(filaedit, "F") = ListBox1.List(x, 5)
a.Cells(filaedit, "G") = ListBox1.List(x, 6)
a.Cells(filaedit, "H") = ListBox1.List(x, 7)
Me.ListBox1.Selected(x) = False
filaedit = filaedit + 1
End If
Next x
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
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