Formulario Traspasos pasar datos a hojas correspondientes.

H o l a:

Estoy revisando tu archivo y veo en tu formulario un listbox.

Entonces, cómo quieres que funcione.

Quieres pasar varios códigos al listbox con el botón ingresar

Luego quieres presionar el botón Aceptar y que la macro lea uno por uno los códigos que están en el listbox y entonces que realice las operaciones, es decir, por cada registro que encuentre en el listbox, que descuente del departamento origen y cargue en el departamento destino.

Otra duda, los descuentos y los cargos, solamente se hacen la hoja "TOTAL GENERAL".

Y por último, quieres que en la hoja "TRASPASOS", se registren los datos de cada traspaso.

E spero tus comentarios.

Hola:

Muchas gracias por tu pronta respuesta a mi consulta.

si la idea seria esa que en mi formulario "Traspasos" y atraves del listbox se vayan cargando los item que se pasan de un departamento a otro y que al pulsar el botón aceptar estas operaciones se hagan en la hoja "Total General" ya que desde allí se alimentan las demás hojas de los departamentos desde el rango cantidad inicial para cada departamento .

y también me gustaría que cada traspaso quedara registrado en la hoja Traspasos yo puse un formato como ejemplo pero lo dejo a tu buen criterio como experto de como seria mas optimo para el proyecto.

Un Saludo

Víctor. 

H o l a:

Te anexo la macro para los traspasos

Private Sub CMD_ACEPTAR_Click()
'Por.Dante Amor
    If CMB_DE = "" Then Exit Sub
    If CMB_A = "" Then Exit Sub
    If CMB_COD = "" Then Exit Sub
    If TXT_CANT_TRAS = "" Or Not IsNumeric(TXT_CANT_TRAS) Then Exit Sub
    If TXT_ORDENTRAS = "" Then Exit Sub
    '
    Set h = Sheets("TOTAL GENERAL")
    Set h2 = Sheets("TRASPASOS")
    Set b = h.Rows("2:5").Find(CMB_DE, lookat:=xlWhole)
    If Not b Is Nothing Then
        col1 = b.Column
        Set b = h.Rows("2:5").Find(CMB_A, lookat:=xlWhole)
        If Not b Is Nothing Then
            col2 = b.Column
            Set b = h.Columns("A").Find(CMB_COD, lookat:=xlWhole)
            If Not b Is Nothing Then
                If h.Cells(b.Row, col1) >= Val(TXT_CANT_TRAS) Then
                    'Actualiza cantidad inicial
                    h.Cells(b.Row, col1) = h.Cells(b.Row, col1) - Val(TXT_CANT_TRAS)
                    h.Cells(b.Row, col2) = h.Cells(b.Row, col2) + Val(TXT_CANT_TRAS)
                    '
                    'Actualiza hoja Traspasos
                    u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
                    num = Application.Max(h2.Range("A3:A" & u)) + 1
                    h2.Cells(u, "A") = num
                    h2.Cells(u, "B") = CMB_DE
                    h2.Cells(u, "C") = CMB_A
                    h2.Cells(u, "D") = TXT_F_TRASPASO
                    h2.Cells(u, "E") = TXT_ORDENTRAS
                    h2.Cells(u, "F") = CMB_COD
                    h2.Cells(u, "G") = CMB_VOZ_TRAS
                    h2.Cells(u, "H") = TXT_CANT_TRAS
                    h2.Cells(u, "I") = TXT_OBSERVACIONES
                    MsgBox "Traspaso realizado", vbInformation, "TRASPASOS"
                Else
                    MsgBox "No se puede traspasar. La cantidad disponible del departamento DE: " & CMB_DE & _
                           " es menor a lo que quiere traspasar", vbCritical, "TRASPASOS"
                End If
            Else
                MsgBox "No existe Código: " & CMB_COD
            End If
        Else
            MsgBox "No existe Departamento: " & CMB_A
        End If
    Else
        MsgBox "No existe Departamento: " & CMB_DE
    End If
End Sub

Sal u dos