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

1 Respuesta

4.649.250 pts. Sancho, si los perros ladran ...

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas