Pasar datos listbox a hoja de Excel




Hoy voy a mostrar como pasar datos de un listbox a una hoja de Excel, a su vez listbox contiene varias columnas que serán copiadas a la hoja de Excel, en este ejemplo también se presenta un buscador que permite encontrar datos listados en el listbox a medida que se escribe, lo que torna el ejemplo interesante y útil para adaptar a cualquier proyecto que se tenga en Excel, ya que la búsqueda de datos es algo fundamental cuando se trabaja con ellos.


  


Antes de continuar, recomiendo que leas un excelente libro sobre Excel el que te ayudará operar las planillas 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.

No hace falta muchos conocimientos para poder adaptar este ejemplo a tu proyecto de macro en Excel, solo cambiar las referencias, es decir nombre de hojas y celdas que contienen los datos o donde se guardarán los datos, si te resulta complicado puedes contactarme y te proporcionaré un guía para que puedas adaptarlo.

El vídeo explica más en detalle su funcionamiento, te recomiendo verlo, además de ver en forma gráfica el ejemplo y que hace cada parte del código, lo cual es un poco complicado de explicar con letras.

A grandes rasgos el ejemplo permite copiar una fila con datos seleccionada en un listbox a una hoja de Excel, para ello se debe seleccionar el datos que necesitemos, que podemos buscar con el buscador instalado en el mismo formulario, una vez encontrado el dato se selecciona y presiona el botón del formulario que permite copiar los datos seleccionados en el listbox a la hoja de Excel.

La codificación primero validad que se haya seleccionado un dato caso contrarío sale un mensaje y no hace nada; en caso que se haya seleccionado, determina en la hoja donde se van a copiar los datos seleccionados del listbox y cual es la última fila con datos copiando los mismos en la fila siguiente que está vacía.

Sugiero descargar el ejemplo y ver su funcionamiento conjuntamente con el vídeo explicativo, desde el link del final se puede descargar su uso es libre; si te fueron de utilidad considera la posibilidad de invitarme una tasa de café para seguir subiendo cosas útiles.

Código que se inserta en un módulo



Sub muestra1()
UserForm1.Show
End Sub

Código que se inserta en un formulario

Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub CommandButton2_Click()
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

Set a = Sheets("Hoja1")
filaedit = a.Range("A" & Rows.Count).End(xlUp).Row + 1
fila = Me.ListBox1.ListIndex
a.Cells(filaedit, "A") = ListBox1.List(fila, 0)
a.Cells(filaedit, "B") = ListBox1.List(fila, 1)
a.Cells(filaedit, "C") = ListBox1.List(fila, 2)
a.Cells(filaedit, "D") = ListBox1.List(fila, 3)
a.Cells(filaedit, "E") = ListBox1.List(fila, 4)
a.Cells(filaedit, "F") = ListBox1.List(fila, 5)
a.Cells(filaedit, "G") = ListBox1.List(fila, 6)
a.Cells(filaedit, "H") = ListBox1.List(fila, 7)
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;120 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;120 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 CargaListbox()
Dim RG As Range, cell As Range
On Error Resume Next
Sheets("BY879VbDAYRA10iBTOMYIUYT").Cells.Clear
Sheets("ARTI").AutoFilterMode = False
uf = Sheets("ARTI").Range("B" & Rows.Count).End(xlUp).Row
With Sheets("ARTI").Range("B9:K" & uf)
   .AutoFilter Field:=2, Criteria1:="=" & TextBox1 & "*"
    Sheets("BY879VbDAYRA10iBTOMYIUYT").Cells.Clear
End With
Set RG = Sheets("ARTI").Range("C21", Sheets("ARTI").Range("C21").End(xlDown)).SpecialCells(xlCellTypeVisible)
RG.CurrentRegion.Copy
Sheets("BY879VbDAYRA10iBTOMYIUYT").Range("a1").PasteSpecial
uf = Sheets("BY879VbDAYRA10iBTOMYIUYT").Range("B" & Rows.Count).End(xlUp).Row
Me.ListBox1.RowSource = "BY879VbDAYRA10iBTOMYIUYT!A1: J" & uf
TextBox1.SetFocus
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