Copiar datos de ListBox a otra hoja comenzando desde una fila en particular y desplazando hacia abajo otras

La información del Listbox se debe copiar sin el encabezado a la hoja "libro" a partir de la fila 11 y debe desplazar unas filas que se encuentran al final de esa hoja, o sea, en las filas 1-10 hay información que no se puede modificar, luego en la fila 11 se debe copiar la información del Listbox y cuando termine de copiar deben quedar 7 filas finales que tampoco se pueden modificar.

Y si es como me preguntaste: primero hay que borrar la información de la hoja "libro" y poner la nueva, es decir, borrar solamente la información que se encuentra entre la filas 11 y antes de las últimas 7 filas.

Después en la hoja "libro" voy a crear un botón que guarde dicha hoja de manera independiente en formato excel para que la puedan enviar vía correo y la puedan imprimir en la parte administrativa.

1

1 respuesta

Respuesta
1

Te anexo la macro

Private Sub CommandButton1_Click()
'Por.Dante Amor
    'filtrar
    Set h1 = Sheets("BASE DE DATOS FACTURACION")
    Set h2 = Sheets("Temporal")
    Set h3 = Sheets("libro")
    col = "F"                   'columna de Fechas
    fila = 5                    'fila de encabezados
    uc = Columns("P").Column    'última columna con datos
    '
    h2.Cells.Clear
    ListBox1.RowSource = ""
    u3 = h3.Range(col & Rows.Count).End(xlUp).Row - 7
    If u3 > 10 Then
        h3.Rows("11:" & u3).Delete
    End If
    '
    'VALIDACIONES
    If TextBox1.Value = "" Or Not IsDate(TextBox1.Value) Then
        MsgBox "Captura una fecha INICIO"
        TextBox1.SetFocus
        Exit Sub
    End If
    If Me.TextBox2.Value = "" Or Not IsDate(TextBox2.Value) Then
        MsgBox "Captura fecha FIN"
        TextBox2.SetFocus
        Exit Sub
    End If
    fec1 = CDate(TextBox1.Value)
    fec2 = CDate(TextBox2.Value)
    If fec2 < fec1 Then
        MsgBox "La fecha FIN no puede ser menor a la fecha INICIO"
        TextBox2.SetFocus
        Exit Sub
    End If
    '
    Application.ScreenUpdating = False
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    coln = Columns(col).Column
    h1.Range(h1.Cells(fila, "A"), h1.Cells(u1, uc)).AutoFilter Field:=coln, _
        Criteria1:=">=" & Format(fec1, "mm/dd/yyyy"), Operator:=xlAnd, _
        Criteria2:="<=" & Format(fec2, "mm/dd/yyyy")
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    h1.Range(h1.Cells(fila, "A"), h1.Cells(u1, uc)).Copy h2.Cells(1, "A")
    u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
    If u2 = 1 Then
        MsgBox "No existen registros con ese filtro", vbExclamation, "FILTRO"
    Else
        rango = Range(Cells(2, "A"), Cells(u2, uc)).Address
        h2.Cells.EntireColumn.AutoFit
        ancho = ""
        For i = 1 To uc
            ancho = ancho & Int(h2.Cells(1, i).Width) + 3 & ";"
        Next
        ListBox1.RowSource = h2.Name & "!" & rango
        ListBox1.ColumnCount = uc
        ListBox1.ColumnHeads = True
        ListBox1.ColumnWidths = ancho
        '
        'Copia a la hoja libro
        h2.Rows("2:" & u2).Copy
        h3.Range("A11").Insert Shift:=xlDown
    End If
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

'.[Sal u dos. No olvides valorar la respuesta. 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas