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 Respuesta
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.
