Pasar un listbox a una hoja de excel
Tengo un listbox2 que se llena de otro listbox1 y de dos textbox y ahora quiero pasarlo todo a una hoja de excel
1 Respuesta

Utiliza lo siguiente para pasar todo el contenido del listbox2 a una hoja a partir de la celda A1. Cambia "hoja1" por el nombre de la hoja donde quieras poner los datos.
Private Sub CommandButton1_Click() 'Por.Dante Amor Set h1 = Sheets("Hoja1") c = listbox1.ColumnCount f = listbox1.ListCount h1.Range(h1.Cells(1, 1), h1.Cells(f, c)) = listbox1.List End Sub
Saludos.Dante Amor
Si es lo que necesitas.

Hola Dante te agradezco mucho, pero pegue la rutina y me puso el siguiente error..
Se ha producido el error 1004 en tiempo de ejecución:
No se puede obtener la propiedad CurrentRegion de la clase Range
Gracias de Nuevo!

Hola, Dante te puedo enviar el archivo para que lo veas, lo he estado haciendo de lo que entiendo de códigos no soy experta, solo me falta eso para que funcione!

El código que puse no utiliza esta propiedad "CurrentRegion"
El código que te envié funciona bien, no entiendo cuál es el problema.
Explícame cómo pusiste mi código dentro del tuyo.

'Cambia el TextBox con cada cambio en el Combo
'
Private Sub cmbEncabezado_Change()
Me.lblFiltro = "Filtro por " & Me.cmbEncabezado.Value
End Sub
'Cerrar formulario
Private Sub CommandButton2_Click()
Unload Me
End Sub
'
'Abrir el formulario para modificar
Private Sub CommandButton3_Click()
If Me.ListBox1.ListIndex < 0 Then
MsgBox "No se ha elegido ningún registro", vbExclamation, "EXCELeINFO"
Else
frmModificar.Show
End If
End Sub
'
'Eliminar el registro
Private Sub CommandButton4_Click()
Pregunta = MsgBox("Está seguro de eliminar el registro?", vbYesNo + vbQuestion, "EXCELeINFO")
If Pregunta <> vbNo Then
ActiveCell.EntireRow.Delete
End If
Call CommandButton5_Click
End Sub
'Mostrar resultado en ListBox
Private Sub CommandButton5_Click()
On Error GoTo Errores
If Me.txtFiltro1.Value = "" Then Exit Sub
Me.ListBox1.Clear
Columna = Me.cmbEncabezado.ListIndex
j = 1
Filas = Range("a1").CurrentRegion.Rows.Count
For i = 2 To Filas
If LCase(Cells(i, j).Offset(0, CInt(Columna)).Value) Like "*" & LCase(Me.txtFiltro1.Value) & "*" Then
Me.ListBox1.AddItem Cells(i, j)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = Cells(i, j).Offset(0, 1)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = Cells(i, j).Offset(0, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Cells(i, j).Offset(0, 3)
Else
End If
Next i
Exit Sub
Errores:
MsgBox "No se encuentra.", vbExclamation, "EXCELeINFO"
End Sub
'agrega los datos al listbox 2
Private Sub CommandButton6_Click()
Dim iIndex
Dim i As Long, j As Long, k As Long
For i = 0 To 1000 ' loop 1000 times for each row in listbox1.
If ListBox1.Selected(i) = True Then 'Get the first selected Row index number.
ListBox2.AddItem TextBox1.Value & TextBox2 & ListBox1.List(i, 0)
j = ListBox2.ListCount - 1 ' counts all items in listbox2. which is one item.
For k = 1 To ListBox1.ColumnCount - 1 'Count the columns listbox1.Now that the first item is in listbox2 _
move over one column & copy the next value to listbox2. loop 4 more times for 4th entry of row one.
ListBox2.List(j, k) = ListBox1.List(i, k)
Next k
End If
Next i
'Llenamos el ListBox
'...CÓDIGO
End Sub '
'borra los datos del lisxtbox 2
Private Sub CommandButton7_Click()
Dim counter As Integer
counter = 0
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i - counter) Then
ListBox2.RemoveItem (i - counter)
counter = counter + 1
End If
Next i
CheckBox2.Value = False
End Sub
Private Sub Label45_Click()
TextBox1.Text = ListBox2.Items.Count
End Sub
'Activar la celda del registro elegido
Private Sub ListBox1_Click()
Range("a2").Activate
Cuenta = Me.ListBox1.ListCount
Set Rango = Range("A1").CurrentRegion
For i = 0 To Cuenta - 1
If Me.ListBox1.Selected(i) Then
Valor = Me.ListBox1.List(i)
Rango.Find(What:=Valor, LookAt:=xlWhole, After:=ActiveCell).Activate
End If
Next i
End Sub
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
For i = 0 To ListBox2.ListCount - 1
ListBox2.Selected(i) = True
Next i
End If
If CheckBox2.Value = False Then
For i = 0 To ListBox2.ListCount - 1
ListBox2.Selected(i) = False
Next i
End If
End Sub
'Dar formato al ListBox y traer los encabezados de la tabla
Private Sub UserForm_Initialize()
'
For i = 1 To 4
Me.Controls("Label" & i) = Cells(1, i).Value
Next i
'
With Me
.ListBox1.ColumnCount = 4
.ListBox1.ColumnWidths = "60 pt;60 pt;60 pt;60 pt"
.cmbEncabezado.List = Application.Transpose(ActiveCell.CurrentRegion.Resize(1).Value)
.cmbEncabezado.ListStyle = fmListStyleOption
End With
With Me
.ListBox2.ColumnCount = 6
.ListBox2.ColumnWidths = "60 pt;120 pt;60 pt;60 pt;60 pt;60 pt"
End With
End Sub
Private Sub UFAgregar_Click()
'PASAMOS LOS DATOS DEL LISTBOX AL NUEVO LIBRO
'Por.Dante Amor
Set h1 = Sheets("LISTA_MATERIALES")
c = ListBox2.ColumnCount
f = ListBox2.ListCount
h1.Range(h1.Cells(1, 1), h1.Cells(f, c)) = ListBox2.List
End Sub
- Compartir respuesta
