Enviar desde listbox datos a hoja de cálculo, fila a fila
Hola expertos como siempre solicitando su experticia. Agradecería muchísimo me ayudaran a encontrar una solución al siguiente problema. Me han solicitado presentar un informe en hoja de cálculo a partir de la información cargada en unos formularios de excel 2007.
La situación es la siguiente, tengo una información que se carga previamente en dos listbox dentro del formulario., uno de los cuales está en la propiedad single y el otro en multiselect. Esto se da por cuanto el uno es referencia del otro. La información que sube en el listbox2 se hace concatenando cuadros te texto y nos genera una frase. El listbox1 trae a él resultado de un filtro. Necesito que cuando haga click sobre un botón comando, la información seleccionada simultáneamente del listbox2 (en single), y el listbox1 (en múltiple), se vayan a la hoja6 del libro de excel, primero descargando en ella los datos del listbox1 (rango A:AF) y luego del listbox2 (celda AG), y que en cada una de las filas descargadas desde el listbox1 en la hoja6, se descargue también la información del listbox2 en la última columna. Es decir por cada dato seleccionado en el listbox1, que me genera luego una fila de datos en la hoja6 de la columnna "A" a la "AF" al dar click, también me copie el dato del listbox2 en la celda "AG"
Yo he intentado la siguiente rutina, pero únicamente me copia la información del listbox2 en la primera fila insertada, las demás las deja en blanco. Ojalá puedan ayudarme con esta consulta:
Private Sub CommandButton9_Click()
For intcount = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(intcount) Then
valor = ListBox1.List(intcount)
Set busca = ActiveSheet.Range("a1:a10000").Find(valor, LookIn:=xlValues, lookat:=xlWhole) If Not busca Is Nothing Then
busca.EntireRow.Copy
Sheets("hoja6").Range("a65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues busca.EntireRow.Delete
End If
ListBox1.RemoveItem (intcount)
End If
Next intcount
Sheets("hoja6").Select
TextBox9 = ListBox2.List(ListBox2.ListIndex)
ListBox2.RemoveItem (ListBox2.ListIndex)
Range("a65000").End(xlUp).Offset(0, 0).Select
ActiveCell.Offset(0, 32).Select
Range(ActiveCell, ActiveCell.Offset(0, 0)).Select
Selection.value = TextBox9
end sub
Gracias de antemano
