Listbox, con posibilidades de copiar en diferentes hojas.
Tengo un formulario con un listbox donde agrego mis productos para realizar las ventas. Quisiera hacer una sección de productos a crédito y quisiera me ayudaran. Si textbox4 tiene algún dato me gustaría que copie los datos en la hoja (ventas_credito) y no en la hoja de (ventas). Les paso el código para que lo revisen. Muchas gracias.
Private Sub CommandButton5_Click()
'Guardar compra en tabla
Dim i As Variant
Dim j As Variant
Dim TransRowRng As Range
Dim NewRow As Integer
With VENTAS
'
For i = Me.ListBox1.ListCount To 1 Step -1
'
Set TransRowRng = ThisWorkbook.Worksheets("VENTAS").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
.Cells(NewRow, 1).Value = Date
.Cells(NewRow, 2).Value = Me.txtConsec.Value
'
For j = 0 To 4
'
.Cells(NewRow, j + 3).Value = Me.ListBox1.List(Me.ListBox1.ListCount - i, j)
'
Next j
'
Next i
'
End With
'
'Pasar información al ticket (Hoja2)
'Por.Dante Amor
'
Set h2 = Sheets("Hoja2")
Set r2 = h2.Range("C7:G20")
r2.ClearContents
col = r2.Cells(1, 1).Column
fila = r2.Cells(1, 1).Row
For i = 0 To ListBox1.ListCount - 1
For j = 0 To 4
h2.Cells(fila, col) = ListBox1.List(i, j)
col = col + 1
Next
col = r2.Cells(1, 1).Column
fila = fila + 1
Next
'
'Fin. Por. Dante Amor
'
Unload Me
End Sub
1 respuesta
Respuesta de Dante Amor
2
H o l a:
Te anexo la macro actualizada
Private Sub CommandButton5_Click()
'Act.Por.Dante Amor
'Guardar compra en tabla
Dim i As Variant
Dim j As Variant
Dim TransRowRng As Range
Dim NewRow As Integer
If TextBox4 = "" Then
Set lahoja = ventas
Else
Set lahoja = Sheets("ventas_credito")
End If
'
With lahoja
'
For i = Me.ListBox1.ListCount To 1 Step -1
'
Set TransRowRng = .Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
.Cells(NewRow, 1).Value = Date
.Cells(NewRow, 2).Value = Me.txtConsec.Value
'
For j = 0 To 4
'
.Cells(NewRow, j + 3).Value = Me.ListBox1.List(Me.ListBox1.ListCount - i, j)
'
Next j
'
Next i
'
End With
'
'Pasar información al ticket (Hoja2)
'Por.Dante Amor
'
Set h2 = Sheets("Hoja2")
Set r2 = h2.Range("C7:G20")
r2.ClearContents
col = r2.Cells(1, 1).Column
fila = r2.Cells(1, 1).Row
For i = 0 To ListBox1.ListCount - 1
For j = 0 To 4
h2.Cells(fila, col) = ListBox1.List(i, j)
col = col + 1
Next
col = r2.Cells(1, 1).Column
fila = fila + 1
Next
'
'Fin. Por. Dante Amor
'
Unload Me
End Sub‘
S a l u d o s . D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s
