Insertar filas en formato dependiendo de registros en listbox

Para Dante Amor

Primero que todo mis más sinceras felicitaciones por la inmensa labor que desempeñas al compartir tus conocimientos con quienes necesitamos de ellos, durante los últimos años he aprendido muchisimo gracias a esa labor desinteresada e incondicinal con los usuarios de Todoexpertos, le considero mi maestro.

Ahora si al grano, espero que esta ves me pueda colaborar con la siguiente situación:

Tengo un aplicativo en excel que he venido desarrollando y para lo cual su apoyo ha sido invaluable, necesito que en un formato que se encuentra en la hoja de nombre Remisión (Hoja11) y que alimento con los datos contenidos en un listbox (Listbox2), cuando se supere 44 registros que son los que caben en el formato establecido (desde fila 12 a 56), se inserte por cada regsitro adicional en el listbox, una fila al formato sin eliminar los últimos campos de observaciones y firmas, esta es la imagen del formato

Espero haber sido claro con la explicacion de mi necesidad.

1 respuesta

Respuesta
1

Responde lo siguiente y en este orden:

1. ¿El listbox está en un userform?

2. Pon aquí el código que utilizas para pasar los datos del listbox a la hoja.

3. ¿Las celdas "B12H56" de la hoja "Remisión" están vacías antes de pasar los datos?

R/1. Si, el nombre del UF es salidas

R/2.

'Actualizo formato Remision
'Muestro la hoja que esta oculta
ActiveWorkbook.Unprotect "1717171"
Hoja11.Visible = xlSheetVisible 'Hoja Remision
'Elimino la informacion anterior
Set hrr = Sheets("Remision")
hrr.Select
For filo = 12 To Range("B11").End(xlDown).Row
Range("B12:I" & filo).ClearContents
Range("F" & filo).ClearContents
Next
Range("H9:I10").ClearContents
'elimina las filas que sobran
    Dim x As Byte
    For filo = 12 To Range("B11").End(xlDown).Row
    If filo < 57 Then filo = 57
    While x = 0
    If Range("B" & filo) <> "Observaciones:" Then
        Range("B" & filo).EntireRow.Delete Shift:=xlUp
        'filo = filo - 1
    Else
        x = 1
    End If
    Wend
Next
'Ingresar fecha del dia
    Range("H8") = "=TODAY()"
'Asignar consecutivo
    Range("I7") =   Application.WorksheetFunction.Max(Sheets("Relacion_Remisiones").Range("A:A")) + 1
'Paso la informacion al formato
For i = 12 To 70 'Indica desde que fila empieza a registrar 'Revisar este codigo
If Hoja11.Cells(i, 1) = "" Then  'Hoja Remision
    final = i
    Exit For
End If
Next
'Se recorre el listbox2
For i = 0 To ListBox2.ListCount - 1
    Hoja11.Cells(final, 2) = ListBox2.List(i, 1)  'cod
    Hoja11.Cells(final, 3) = ListBox2.List(i, 2)  'Descripcion
    Hoja11.Cells(final, 6) = ListBox2.List(i, 0)  'cant
    final = final + 1
    Next
'se busca Unidad y precio
  For filo = 12 To Range("B11").End(xlDown).Row
    Dim buscoit
    Set buscoit = Hoja5.Range("A:A").Find(Cells(filo, 2), LookIn:=xlValues, lookat:=xlWhole)
    If Not buscoit Is Nothing Then
'pasa unid y precio del item
            Cells(filo, 5) = buscoit.Offset(0, 3) 'Unidad de Medida
         '   Cells(filo, 6) = buscoit.Offset(0, 4) 'Precio
             Set buscoit = Nothing
        Else
            Range(Cells(filo, 5), Cells(filo, 6)) = ""
         Exit For
        End If
    Next
 'Asignar consecutivo
 '   Range("I7") = Application.WorksheetFunction.Max(Sheets("Relacion_Remisiones").Range("B:B")) + 1
 'Se oculta la Hoja Remision
  Hoja11.Visible = xlSheetVeryHidden

R/3.  Pues diría que si, porque dentro del código hay instrucciones para que si hay información se limpie antes de pasar la nueva información.

De antemano mil y mil gracias

Pon aquí el código, utiliza el icono para insertar código

'Actualizo formato Remision
'Muestro la hoja que esta oculta
ActiveWorkbook.Unprotect "1717171"
Hoja11.Visible = xlSheetVisible 'Hoja Remision
'Elimino la informacion anterior
Set hrr = Sheets("Remision")
hrr.Select
For filo = 12 To Range("B11").End(xlDown).Row
Range("B12:I" & filo).ClearContents
Range("F" & filo).ClearContents
Next
Range("H9:I10").ClearContents
'elimina las filas que sobran
    Dim x As Byte
    For filo = 12 To Range("B11").End(xlDown).Row
    If filo < 57 Then filo = 57
    While x = 0
    If Range("B" & filo) <> "Observaciones:" Then
        Range("B" & filo).EntireRow.Delete Shift:=xlUp
        'filo = filo - 1
    Else
        x = 1
    End If
    Wend
Next
'Ingresar fecha del dia
    Range("H8") = "=TODAY()"
'Asignar consecutivo
    Range("I7") = Application.WorksheetFunction.Max(Sheets("Relacion_Remisiones").Range("A:A")) + 1
'Paso la informacion al formato
For i = 12 To 70 'Indica desde que fila empieza a registrar
If Hoja11.Cells(i, 1) = "" Then  'Hoja Remision
    final = i
    Exit For
End If
Next
'Se recorre el listbox2
For i = 0 To ListBox2.ListCount - 1
    Hoja11.Cells(final, 2) = ListBox2.List(i, 1)  'cod
    Hoja11.Cells(final, 3) = ListBox2.List(i, 2)  'Descripcion
    Hoja11.Cells(final, 6) = ListBox2.List(i, 0)  'cant
    final = final + 1
    Next
'se busca Unidad y precio
  For filo = 12 To Range("B11").End(xlDown).Row
    Dim buscoit
    Set buscoit = Hoja5.Range("A:A").Find(Cells(filo, 2), LookIn:=xlValues, lookat:=xlWhole)
    If Not buscoit Is Nothing Then
'pasa unid y precio del item
            Cells(filo, 5) = buscoit.Offset(0, 3) 'Unidad de Medida
         '   Cells(filo, 6) = buscoit.Offset(0, 4) 'Precio
            Set buscoit = Nothing
        Else
            Range(Cells(filo, 5), Cells(filo, 6)) = ""
         Exit For
        End If
    Next
 'Asignar consecutivo
 '   Range("I7") = Application.WorksheetFunction.Max(Sheets("Relacion_Remisiones").Range("B:B")) + 1
    'Se oculta la Hoja Remision
  Hoja11.Visible = xlSheetVeryHidden
  

Que pena, no sabia que el código se debe insertar por esa opción

Que pena, no sabia que el código se debe insertar por esa opción

Poner el código de esa manera, permite leerlo de mejor manera y es más fácil de copiar.

Algunos tips:

- Cuando estableces una variable para la hoja, debes utilizarla como referencia en todas las instrucciones que utilicen esa hoja, por ejemplo:

  Set sh = Sheets("Remision")
  'Actualizar datos
  sh.Range("H8") = "=TODAY()"
  'Eliminar la informacion anterior
  Sh. Range("H9:I10"). ClearContents

De esa manera no es necesario seleccionar la hoja, incluso, tampoco es necesario hacer visible la hoja.

- Puse solamente un ciclo For, pone la información en la hoja y al mismo tiempo busca la Unidad de Medida.

- Para limpiar el formato: Elimino las filas, borro la información y por último inserto solamente las filas necesarias para recibir la información del listbox.

Prueba el siguiente código

Private Sub CommandButton1_Click()
'Actualizo formato Remision
  Dim f As Range, sh As Worksheet
  Dim i As Long, j As Long
  Application.ScreenUpdating = False
  '
  Set sh = Sheets("Remision")
  'Actualizar datos
  sh.Range("H8") = "=TODAY()"
  sh.Range("I7") = Application.WorksheetFunction.Max(Sheets("Relacion_Remisiones").Range("A:A")) + 1
  'Eliminar la informacion anterior
  sh.Range("H9:I10").ClearContents
  sh.Range("B12:I13").ClearContents
  Set f = sh.Range("B:I").Find("OBSERVACIONES", , xlValues, xlPart, , xlPrevious, False)
  If Not f Is Nothing Then
    If f.Row > 14 Then sh.Range("B14:B" & f.Row - 1).EntireRow.Delete
  End If
  With ListBox2
    j = .ListCount
    If j > 2 Then
      sh.Rows(12).Copy
      sh.Rows("13:" & 13 + j - 3).Insert Shift:=xlDown
    End If
  'Pasar la informacion al formato
    j = 12
    For i = 0 To .ListCount - 1
      sh.Cells(j, 2) = .List(i, 1)      'cod
      sh.Cells(j, 3) = .List(i, 2)      'Descripcion
      sh.Cells(j, 6) = .List(i, 0)      'cant
      '
      Set f = Hoja5.Range("A:A").Find(.List(i, 2), , xlValues, xlWhole)
      If Not f Is Nothing Then
        sh.Cells(j, 5) = f.Offset(, 3)  'u medida
      End If
      j = j + 1
    Next
  End With
  Application.ScreenUpdating = True
  Application.CutCopyMode = False
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

´No sé que fórmulas usar para resolverme el problema

La imagen no me la sube y tampoco veo como se sube un fichero, os intentaré explicar lo mejor que pueda mi problema. En una hoja Excel tengo hallados los pagos por formas de pago: SUMAR.SI(D1:D16;"Efectivo";B1:B16), y...
3 respuestas

¿Cómo ajustar texto automáticamente en celdas combinadas en Excel 2019?

Solicito amablemente su valiosa ayuda para ajustar automáticamente un rango de celdas de una columna, he intentado con la opción de ajuste autamático de filas, también con al opción de ajustar texto de la pestaña inicio e incluso con la siguiente...
1 respuesta

¿Cómo resolver num a letras en excel?

En un libro excel habilitado para macros al convertir números a letras, en lugar de aparecer el resultado esperado aparece el mensaje # ¿NOMBRE?.
1 respuesta

¿Cómo usar un excel con macros desde varios ordenadores?

A tod@s! Tengo una aplicación en excel para introducir datos y visualizarlos con diferentes formularios creados. Lo que quiero hacer es: 1 Que ese libro este alojado en un sitio común y que lo puedan abrir desde varios ordenadores. 2º Que se pueda...
3 respuestas

Error en macro al ejecutar el botón aceptar

Necesitaría la colaboración para resolver el error que sucede al ejecutar el botón aceptar Set mifila = Hoja2.ListObjects(1).ListRows.Add Lo que yo agregue solamente a la base fue una columna al inicio ("A") anteriormente se llamaba Tabla6 y yo ahora...
1 respuesta

Detectar cambios en tabla dinámica

Tengo una hoja donde se van actualizando datos mediante una tabla dinámica. ¿Cómo detecto cuando se producen cambios (sólo en la parte de la tabla dinámica) para ejecutar otra macro en la misma hoja?
1 respuesta

Macro con combinación de teclas

Acudo aquí buscando ayuda, ¿Cómo crear una macro que genere una combinación de teclas? NO se trata de asignar una macro a una combinación de teclas, es todo lo contrario. El problema radica en que tengo una macro que rellena ciertas celdas con...
1 respuesta

Pasar datos de listbox a hoja con decimales

Como están estimados maestros y maestras, una vez mas solicitando vuestra experta ayuda. Tengo un formulario que busca datos entre 2 fechas desde 2 textbox, carga en listbox lo filtrado, en la columna 2 del listbox carga valores con formato de 2...
1 respuesta

Una macro que de aviso sobre vencimiento de una cedula de identidad

Tengo una hoja de calculo de 6 columnas en donde la columna A es fecha de vencimiento, las columnas B, C, y D son apellidos paterno, Materno u nombres, la columna E es el numero de cedula de identidad Con Formato ##.###.###-# la columna F es lo...
1 respuesta

Error decimales en hoja de excel

Tengo un albarán de varios productos que no vienen desglosado el iva En una hoja Excel introduzco el precio, con la formula sumar el precio lo desgloso en base imponible y el iva paracque me dé el precio del producto pero cuando sumo el total de...
4 respuestas