Macro para modificar registro en 2 hojas diferentes

Macro para modificar registro en 2 hojas diferentes

Hola

Quiero modificar registro en 2 hojas diferentes

El asunto es que tengo un código que agrega el registro la primera vez en en las 2 hojas pero cuando quiero modificarlo no puedo, en la hoja2 si se modifica el registro pero en la hoja20 no se modifica sino que se vuelve a agregar.

Este código uso para agregar el registro la primera vez en las 2 hojas

Dim ArchivoIMG As String
Public modificando

'
Private Sub cmd_Agregar_Click()
'
If Not UCase(Left(TextBox1, 1)) Like "[A-Z]" Then
MsgBox "Nombre inválido", vbInformation + vbOKOnly
TextBox1.SetFocus
Exit Sub
End If
'
If OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False And OptionButton4.Value = False And OptionButton5.Value = False And OptionButton8.Value = False Then
MsgBox "Debes seleccionar algún botón de Cliente. Luego ejecuta nuevamente el botón de guardado.", , "ERROR"
Exit Sub
End If
'
If OptionButton6 = False And OptionButton7 = False Then
MsgBox "Selecciona la opción de agregar o modificar"
Exit Sub
End If
'
If TextBox1 = "" Then
MsgBox "Escribe el nuevo nombre"
TextBox1.SetFocus
Exit Sub
End If
'
If OptionButton6 Then 'Agregar registro
Set b = Columns("A").Find(TextBox1, lookat:=xlWhole)
If Not b Is Nothing Then
MsgBox "El nombre ya existe"
TextBox1.SetFocus
Exit Sub
End If
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Select
ElseIf OptionButton7 Then ' modificar
modificando = True
If cbo_Nombre.ListIndex = -1 Then
modificando = False
MsgBox "Para modificar un nombre, primero tienes que seleccionar uno"
cbo_Nombre.SetFocus
Exit Sub
End If
End If
'Aqui es cuando agregamos o modificamos el registro
ActiveCell = TextBox1
ActiveCell.Offset(0, 1) = txt_numero
ActiveCell.Offset(0, 2) = txt_conteofisico
ActiveCell.Offset(0, 3) = txt_fechaven
ActiveCell.Offset(0, 4) = txt_numerolote
ActiveCell.Offset(0, 5) = txt_nukardex
ActiveCell.Offset(0, 6) = txt_fekardex
ActiveCell.Offset(0, 7) = txt_ultimosaldo
ActiveCell.Offset(0, 8) = txt_observaciones
ActiveCell.Offset(0, 9) = ArchivoIMG
Call movimientos
Columns("J").EntireColumn.Hidden = True
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A2")
.SetRange Range("A3:J" & Range("A" & Rows.Count).End(xlUp).Row)
.Header = xlNo: .MatchCase = False: .Orientation = xlTopToBottom
.SortMethod = xlPinYin: .Apply
End With
'
LimpiarFormulario
Range("A3").Activate
Range("A3").Activate
cbo_Nombre.SetFocus
End Sub

Sub movimientos()
Dim TransRowRng As Range
Dim NewRow As Integer

Set TransRowRng = Sheets("Movimientos").Cells(1, 1).CurrentRegion
NewRow = TransRowRng.Rows.Count + 1
With Sheets("Movimientos")
.Cells(NewRow, 1).Value = Me.TextBox1
.Cells(NewRow, 3).Value = Me.txt_conteofisico
.Cells(NewRow, 8).Value = Me.txt_fechaven
.Cells(NewRow, 9).Value = Me.txt_numerolote
.Cells(NewRow, 10).Value = Range("O3").Value
End With
Set hm = Sheets("Movimientos")
With hm.UsedRange
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
Sheets("Movimientos").Range("B:J").HorizontalAlignment = xlCenter
End Sub

1 Respuesta

Respuesta
2

El problema está en la subrutina 'Movimientos' que debiera evaluar si se trata de una modificación o de un agregado.

Sub movimientos()
Dim TransRowRng As Range
Dim NewRow As Integer
'declaro la hoja para no tener que activarla
Set hm = Sheets("Movimientos")
'separar el proceso ya sea Agregar o Modificar
If OptionButton6.Value = True Then     'Agregar
    Set TransRowRng = hm.Cells(1, 1).CurrentRegion
        NewRow = TransRowRng.Rows.Count + 1
        With hm
            .Cells(NewRow, 1).Value = Me.TextBox1
            .Cells(NewRow, 3).Value = Me.txt_conteofisico
            .Cells(NewRow, 8).Value = Me.txt_fechaven
            .Cells(NewRow, 9).Value = Me.txt_numerolote
            .Cells(NewRow, 10).Value = Range("O3").Value
        End With
    With hm.UsedRange
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Borders(xlInsideVertical).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    hm.Range("B:J").HorizontalAlignment = xlCenter
Else
    'se busca el registro en col A para modificarlo
    Set busco = hm.Range("A:A").Find(TextBox1, LookIn:=xlValues, lookat:=xlWhole)
    'si encuentra el elemento lo modifica, sino comenta
    If Not busco Is Nothing Then
        NewRow = busco.Row
        With hm
            .Cells(NewRow, 1).Value = Me.TextBox1
            .Cells(NewRow, 3).Value = Me.txt_conteofisico
            .Cells(NewRow, 8).Value = Me.txt_fechaven
            .Cells(NewRow, 9).Value = Me.txt_numerolote
            .Cells(NewRow, 10).Value = Range("O3").Value
        End With
    Else
        MsgBox "No se encontró este producto en hoja 'Movimientos'.", , "ATENCIÓN"
    End If
End If
End Sub

PD) ¿Hay 2 personas haciendo el mismo trabajo.... o sos un usuario que utiliza 2 nombres distintos? 

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas