¿Como guardar listado de ListBox cargado por RowSource?
Quisiera me pudieran ayudar orientándome como puedo guardar mediante un botón todo el listado que aparece en un ListBox el cual fue cargado por RowSource.
1 respuesta
Con el siguiente código te pone todos los datos del listbox en la hoja2
Private Sub CommandButton1_Click()
'Por.Dante Amor
Set h1 = Sheets("Hoja2")
h1.Cells.ClearContents
c = ListBox1.ColumnCount
f = ListBox1.ListCount
h1.Range(h1.Cells(1, "A"), h1.Cells(f, c)) = ListBox1.List
End Subcambia "Hoja2" por la hoja donde quieras poner la información.
'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
Muchas gracias funciona bien, pero tengo un detalle el userform donde tengo el listbox es un buscador por filtro por fecha y edad, cuando inicializa y le doy al botón guardar ejecuta bien tu macro, pero cuando realizo el filtrado y le doy guardar me lanza el siguiente error. podras decirme en que crees radique el error que lanza
Puedes poner todo el código de tu userform para ver cómo haces el filtrado
Este es el código de todo el userform
Private Sub CommandButton1_Click()
Set h1 = Sheets("ReporteSalidas")
h1.Cells.ClearContents
c = ListBox1.ColumnCount
f = ListBox1.ListCount
h1.Range(h1.Cells(1, "A"), h1.Cells(f, c)) = ListBox1.List
MsgBox ("Los datos se copiaron con éxito"), vbInformation, "AVISO"
End Sub
Private Sub CommandButton2_Click()
On Error Resume Next
Set b = Sheets("Salidas")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
dato1 = CDate(TextBox2)
dato2 = CDate(TextBox3)
If dato2 = Empty Or dato1 = emtpy Then
MsgBox ("Debe ingresar datos para consulta entre rango de fechas"), vbCritical, "AVISO"
Exit Sub
End If
If dato2 < dato1 Then
MsgBox ("La fecha final no puede ser mayor a la fecha inicial"), vbCritical, "AVISO"
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
'Elimina hoja y crea hoja dando el mismo nombre que la eliminada
Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD").Delete
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "DFSHJFDUYDAYRAIUY544TTTOMYDUTGD"
Set a = Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD")
b.Range("A1:L1").Copy Destination:=a.Range("A1")
fila = 2
If dato2 < dato1 Then
MsgBox ("La fecha final no puede ser mayor a la fecha inicial"), vbCritical, "AVISO"
Exit Sub
End If
For i = 2 To uf
strg = b.Cells(i, 5).Value
dato0 = CDate(b.Cells(i, 9).Value)
If UCase(strg) Like UCase(TextBox1.Value) & "*" And dato0 >= dato1 And dato0 <= dato2 Then
a.Cells(fila, 1) = b.Cells(i, 1)
a.Cells(fila, 2) = b.Cells(i, 2)
a.Cells(fila, 3) = b.Cells(i, 3)
a.Cells(fila, 4) = b.Cells(i, 4)
a.Cells(fila, 5) = b.Cells(i, 5)
a.Cells(fila, 6) = b.Cells(i, 6)
a.Cells(fila, 7) = b.Cells(i, 7)
a.Cells(fila, 8) = b.Cells(i, 8)
a.Cells(fila, 9) = VBA.Format(b.Cells(i, 9), "mm/dd/yyyy;@")
a.Cells(fila, 10) = b.Cells(i, 10)
a.Cells(fila, 11) = b.Cells(i, 11)
a.Cells(fila, 12) = b.Cells(i, 12)
fila = fila + 1
End If
Next i
a.Range("I").NumberFormat = VBA.Format("dd/mm/yyyy")
uf = a.Range("A" & Rows.Count).End(xlUp).Row
uc = a.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
.ColumnCount = 12
.ColumnWidths = "55;150;50;45;85;55;85;70;70;90;100;70"
.RowSource = "DFSHJFDUYDAYRAIUY544TTTOMYDUTGD!A1:" & wc & uf
End With
a.Delete
End Sub
Private Sub TextBox1_Change()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
Set b = Sheets("Salidas")
uf = b.Range("A" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
Me.ListBox1.RowSource = "Hoja1!A1:L" & uf
Me.ListBox1.ColumnCount = 12
Me.ListBox1.ColumnWidths = "55;150;50;45;85;55;85;70;70;90;100;70"
Exit Sub
End If
b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
dato1 = CDate(TextBox2)
dato2 = CDate(TextBox3)
'Elimina hoja y crea hoja dando el mismo nombre que la eliminada
Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD").Delete
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "DFSHJFDUYDAYRAIUY544TTTOMYDUTGD"
Set a = Sheets("DFSHJFDUYDAYRAIUY544TTTOMYDUTGD")
b.Range("A1:L1").Copy Destination:=a.Range("A1")
fila = 2
For i = 2 To uf
strg = b.Cells(i, 5).Value
If UCase(strg) Like UCase(TextBox1.Value) & "*" Then
a.Cells(fila, 1) = b.Cells(i, 1)
a.Cells(fila, 2) = b.Cells(i, 2)
a.Cells(fila, 3) = b.Cells(i, 3)
a.Cells(fila, 4) = b.Cells(i, 4)
a.Cells(fila, 5) = b.Cells(i, 5)
a.Cells(fila, 6) = b.Cells(i, 6)
a.Cells(fila, 7) = b.Cells(i, 7)
a.Cells(fila, 8) = b.Cells(i, 8)
a.Cells(fila, 9) = VBA.Format(b.Cells(i, 9), "mm/dd/yyyy;@")
a.Cells(fila, 10) = b.Cells(i, 10)
a.Cells(fila, 11) = b.Cells(i, 11)
a.Cells(fila, 12) = b.Cells(i, 12)
fila = fila + 1
End If
Next i
a.Range("I").NumberFormat = VBA.Format("dd/mm/yyyy")
uf = a.Range("A" & Rows.Count).End(xlUp).Row
uc = a.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
.ColumnCount = 12
.ColumnWidths = "55;150;50;45;85;55;85;70;70;90;100;70"
.RowSource = "DFSHJFDUYDAYRAIUY544TTTOMYDUTGD!A1:" & wc & uf
End With
a.Delete
End Sub
Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("Salidas")
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 = 12
.ColumnWidths = "55;150;50;45;85;55;85;70;70;90;100;70"
.RowSource = "Salidas!A1:" & 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 = False
Fin:
End Sub
El problema es porque estás borrando la hoja.
El RowSource es la fuente de la información, si borras la hoja, estás borrando la fuente, entonces cuando la quiere utilizar la instrucción listbox1. List envía el error.
El problema se soluciona si borras del código la línea:
a.Delete
[Sal u dos
Muchas gracias Dante ya lo quite de ese código y lo puse en el botón cerrar para que se elimine la hoja ya que 3s solamente temporal. Saludos
@dante amor
Buenos días:
Fíjate que note que el código que me distes para guardar empieza a pegar los datos en la primer fila, ya cambie aquí el 1 por el 2 y ya empieza a pegar en la fila 2 pero la fila 1 donde tengo la cabeza de la tabla me la borra que crees que falte
h1.Range(h1.Cells(1, "A"), h1.Cells(f, c)) = ListBox1.List
Lo que pasa es que al inicio de la macro se limpia la hoja, cambia esta línea
H1. Cells. ClearContents
Por esta:
H1.rows("2:" & rows. Count). ClearContentsTambién cambia esta línea:
H1. Range(h1.Cells(1, "A"), h1.Cells(f, c)) = ListBox1. List
Por esta:
H1. Range(h1.Cells(2, "A"), h1.Cells(f+1, c)) = ListBox1. List
tienes que aumentar el número de filas en el rango que va a recibir los datos, si aumentaste de 1 a 2 al inicio, también tienes que sumar + 1 al final.
