Guardar ingresos del formulario de arriba hacia abajo

Tengo el siguiente código:

Public Sub btn_guardar_Click()
    Set h = Sheets("REGISTRO")
    Set h2 = Sheets("DATOS")
    u = 2
    Do While h.Cells(u, "B") <> ""
        u = u + 1
    Loop
    ab1 = combo_Entrantes.List(combo_Entrantes.ListIndex, 1)
    ab2 = combo_Salientes.List(combo_Salientes.ListIndex, 1)
    If ab2 <> "" Then ab1 = "x" & ab1
    ab12 = ab2 & ab1
    '
    .....
    End If
    If ab1 <> "" Then ab1 = "x" & ab1
    h.Cells(u, "A") = txtbox_pos
    h.Cells(u, "B") = cad
    h.Cells(u, "C") = Date
    h.Cells(u, "D") = "IM" & form_IMS.txtbox_IM.Value
    h.Cells(u, "E") = form_IMS.combo_Entrantes.Value
    h.Cells(u, "F") = form_IMS.txtbox_serieEntrante.Value
    h.Cells(u, "G") = form_IMS.combo_Salientes.Value
    h.Cells(u, "H") = form_IMS.txtbox_serieSaliente.Value
    h.Cells(u, "I") = form_IMS.combo_sim1Entrante.Value
    h.Cells(u, "J") = form_IMS.txtbox_serieSimEntrante.Value
    h.Cells(u, "K") = form_IMS.combo_sim1Saliente.Value
    h.Cells(u, "L") = form_IMS.txtbox_serieSim1Saliente.Value
    h.Cells(u, "M") = form_IMS.combo_sim2Entrante.Value
    h.Cells(u, "N") = form_IMS.txtbox_serieSim2Entrante.Value
    h.Cells(u, "O") = form_IMS.combo_sim2Saliente.Value
    h.Cells(u, "P") = form_IMS.txtbox_serieSim2Saliente.Value
    h.Cells(u, "Q") = form_IMS.txtbox_detalle.Value
    ThisWorkbook.Save
    '
    'enviar_Correo
    'campos_predeterminados
    'txtbox_pos.SetFocus
End Sub

Este me guarda lo ingresado en el formulario en la primera fila vacía que encuentre.

Necesito algo similar pero que me vaya insertando una fila nueva por cada ingreso, de manera que el ingreso más reciente vaya quedando después del encabezado siempre.

Foto de la hoja de registro:

1 respuesta

Respuesta
1

Te anexo la macro actualizada

Public Sub btn_guardar_Click()
'Por.Dante Amor
    Set h = Sheets("REGISTRO")
    Set h2 = Sheets("DATOS")
    u = 2
    h.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ab1 = combo_Entrantes.List(combo_Entrantes.ListIndex, 1)
    ab2 = combo_Salientes.List(combo_Salientes.ListIndex, 1)
    If ab1 <> "" Then ab1 = "x" & ab1
    ab12 = ab2 & ab1
    '
    Select Case combo_sim1Saliente.List(combo_sim1Saliente.ListIndex, 1)
        Case "": sa1 = ""
        Case Else: sa1 = combo_sim1Saliente.List(combo_sim1Saliente.ListIndex, 1)
    End Select
    '
    Select Case combo_sim2Saliente.List(combo_sim2Saliente.ListIndex, 1)
        Case "": sa2 = ""
        Case Else: sa2 = combo_sim2Saliente.List(combo_sim2Saliente.ListIndex, 1)
    End Select
    '
    Select Case combo_sim1Entrante.List(combo_sim1Entrante.ListIndex, 1)
        Case "": se1 = ""
        Case Else: se1 = combo_sim1Entrante.List(combo_sim1Entrante.ListIndex, 1)
    End Select
    '
    Select Case combo_sim2Entrante.List(combo_sim2Entrante.ListIndex, 1)
        Case "": se2 = ""
        Case Else: se2 = combo_sim2Entrante.List(combo_sim2Entrante.ListIndex, 1)
    End Select
    '
    'Para 0 salientes
    If sa1 = "" And sa2 = "" And se1 = "" And se2 = "" Then
        cad = ab12
    End If
    If sa1 = "" And sa2 = "" And se1 <> "" And se2 = "" Then
        cad = ab12 & " +" & se1
    End If
    If sa1 = "" And sa2 = "" And se1 = "" And se2 <> "" Then
        cad = ab12 & " +" & se2
    End If
    If sa1 = "" And sa2 = "" And se1 <> "" And se2 <> "" Then
        cad = ab12 & " +" & se1 & " +" & se2
    End If
    '
    'Para un saliente
    If sa1 <> "" And sa2 = "" And se1 = "" And se2 = "" Then
        cad = ab12 & " -" & sa1
    End If
    If sa1 = "" And sa2 <> "" And se1 = "" And se2 = "" Then
        cad = ab12 & " -" & sa2
    End If
    If sa1 <> "" And sa2 = "" And se1 <> "" And se2 = "" Then
        cad = ab12 & " " & sa1 & "x" & se1
    End If
    If sa1 <> "" And sa2 = "" And se1 = "" And se2 <> "" Then
        cad = ab12 & " " & sa1 & "x" & se2
    End If
    If sa1 <> "" And sa2 = "" And se1 <> "" And se2 <> "" Then
        cad = ab12 & " " & sa1 & "x" & se1 & " +" & se2
    End If
    If sa1 = "" And sa2 <> "" And se1 <> "" And se2 = "" Then
        cad = ab12 & " " & sa2 & "x" & se1
    End If
    If sa1 = "" And sa2 <> "" And se1 = "" And se2 <> "" Then
        cad = ab12 & " " & sa2 & "x" & se2
    End If
    If sa1 = "" And sa2 <> "" And se1 <> "" And se2 <> "" Then
        cad = ab12 & " " & sa2 & "x" & se2 & " +" & se1
    End If
    '
    'Para 2 salientes
    If sa1 <> "" And sa2 <> "" And se1 = "" And se2 = "" Then
        cad = ab12 & " -" & sa1 & " -" & sa2
    End If
    If sa1 <> "" And sa2 <> "" And se1 <> "" And se2 = "" Then
        cad = ab12 & " " & sa1 & "x" & se1 & " -" & sa2
    End If
    If sa1 <> "" And sa2 <> "" And se1 = "" And se2 <> "" Then
        cad = ab12 & " " & sa2 & "x" & se2 & " -" & sa1
    End If
    If sa1 <> "" And sa2 <> "" And se1 <> "" And se2 <> "" Then
        cad = ab12 & " " & sa1 & "x" & se1 & " " & sa2 & "x" & se2
    End If
    '
    h.Cells(u, "A") = txtbox_pos
    h.Cells(u, "B") = cad
    h.Cells(u, "C") = Date
    h.Cells(u, "D") = Time
    '
    'mandar_Correo
    'campos_predeterminados
    'txtbox_pos.SetFocus
End Sub

Dante, funciona bien pero me copia el formato del encabezado:

Como evito eso?, Saludos!

Pero tenías una tabla, ¿la convertiste a rango?

Prueba con la siguiente:

Public Sub btn_guardar_Click()
'Por.Dante Amor
    Set h = Sheets("REGISTRO")
    Set h2 = Sheets("DATOS")
    u = 2
    h.Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
    ab1 = combo_Entrantes.List(combo_Entrantes.ListIndex, 1)
    ab2 = combo_Salientes.List(combo_Salientes.ListIndex, 1)
    If ab1 <> "" Then ab1 = "x" & ab1
    ab12 = ab2 & ab1
    '
    Select Case combo_sim1Saliente.List(combo_sim1Saliente.ListIndex, 1)
        Case "": sa1 = ""
        Case Else: sa1 = combo_sim1Saliente.List(combo_sim1Saliente.ListIndex, 1)
    End Select
    '
    Select Case combo_sim2Saliente.List(combo_sim2Saliente.ListIndex, 1)
        Case "": sa2 = ""
        Case Else: sa2 = combo_sim2Saliente.List(combo_sim2Saliente.ListIndex, 1)
    End Select
    '
    Select Case combo_sim1Entrante.List(combo_sim1Entrante.ListIndex, 1)
        Case "": se1 = ""
        Case Else: se1 = combo_sim1Entrante.List(combo_sim1Entrante.ListIndex, 1)
    End Select
    '
    Select Case combo_sim2Entrante.List(combo_sim2Entrante.ListIndex, 1)
        Case "": se2 = ""
        Case Else: se2 = combo_sim2Entrante.List(combo_sim2Entrante.ListIndex, 1)
    End Select
    '
    'Para 0 salientes
    If sa1 = "" And sa2 = "" And se1 = "" And se2 = "" Then
        cad = ab12
    End If
    If sa1 = "" And sa2 = "" And se1 <> "" And se2 = "" Then
        cad = ab12 & " +" & se1
    End If
    If sa1 = "" And sa2 = "" And se1 = "" And se2 <> "" Then
        cad = ab12 & " +" & se2
    End If
    If sa1 = "" And sa2 = "" And se1 <> "" And se2 <> "" Then
        cad = ab12 & " +" & se1 & " +" & se2
    End If
    '
    'Para un saliente
    If sa1 <> "" And sa2 = "" And se1 = "" And se2 = "" Then
        cad = ab12 & " -" & sa1
    End If
    If sa1 = "" And sa2 <> "" And se1 = "" And se2 = "" Then
        cad = ab12 & " -" & sa2
    End If
    If sa1 <> "" And sa2 = "" And se1 <> "" And se2 = "" Then
        cad = ab12 & " " & sa1 & "x" & se1
    End If
    If sa1 <> "" And sa2 = "" And se1 = "" And se2 <> "" Then
        cad = ab12 & " " & sa1 & "x" & se2
    End If
    If sa1 <> "" And sa2 = "" And se1 <> "" And se2 <> "" Then
        cad = ab12 & " " & sa1 & "x" & se1 & " +" & se2
    End If
    If sa1 = "" And sa2 <> "" And se1 <> "" And se2 = "" Then
        cad = ab12 & " " & sa2 & "x" & se1
    End If
    If sa1 = "" And sa2 <> "" And se1 = "" And se2 <> "" Then
        cad = ab12 & " " & sa2 & "x" & se2
    End If
    If sa1 = "" And sa2 <> "" And se1 <> "" And se2 <> "" Then
        cad = ab12 & " " & sa2 & "x" & se2 & " +" & se1
    End If
    '
    'Para 2 salientes
    If sa1 <> "" And sa2 <> "" And se1 = "" And se2 = "" Then
        cad = ab12 & " -" & sa1 & " -" & sa2
    End If
    If sa1 <> "" And sa2 <> "" And se1 <> "" And se2 = "" Then
        cad = ab12 & " " & sa1 & "x" & se1 & " -" & sa2
    End If
    If sa1 <> "" And sa2 <> "" And se1 = "" And se2 <> "" Then
        cad = ab12 & " " & sa2 & "x" & se2 & " -" & sa1
    End If
    If sa1 <> "" And sa2 <> "" And se1 <> "" And se2 <> "" Then
        cad = ab12 & " " & sa1 & "x" & se1 & " " & sa2 & "x" & se2
    End If
    '
    h.Cells(u, "A") = txtbox_pos
    h.Cells(u, "B") = cad
    h.Cells(u, "C") = Date
    h.Cells(u, "D") = Time
    '
    'mandar_Correo
    'campos_predeterminados
    'txtbox_pos.SetFocus
End Sub

Si debí convertirla a rango ya que el formulario sera usado en más de un PC a la vez y no me dejaba compartirlo para hacer las pruebas estando la tabla

Pero con la última macro ya no debes tener problemas

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas