.
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.
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).
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.
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
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