Macro que Actualice un libro llamado inventario de uno llamado servicios

He utilizado tu macro estos meses me ha servido muchísimo, pero sigo invirtiendo mucho tiempo en la operación, ya que debo filtrar los registros en el archivo tm, y actualizar movimiento por movimiento el archivo servicios, quisiera que me ayudaras modificándola de tal forma que con un solo clic ella realice todo el recorrido en el archivo servicios y me actualice el archivo tm

Dirigido a Dante amor

Private Sub Worksheet_Change(ByVal Target As Range) 'Por.Dante Amor     If Not Intersect(Target, Range("Y:Y")) Is Nothing Then         If Target.Count = 1 Then             Set l1 = ThisWorkbook             Set h1 = l1.ActiveSheet             Set l2 = Workbooks("Archivo tm")             Set h2 = l2.Sheets("Inventario ")             Set r = h2.Columns("B")             Set b = r.Find(h1.Cells(Target.Row, "B"), lookat:=xlWhole)             pos = h1.Cells(Target.Row, "I")             existe = False             If Not b Is Nothing Then                 ncell = b.Address                 Do                     If h2.Cells(b.Row, "H") = pos Then                         existe = True                         Exit Do                     End If                     Set b = r.FindNext(b)                 Loop While Not b Is Nothing And b.Address <> ncell             Else                 existe = False             End If             If existe Then                 h2.Cells(b.Row, "A") = h1.Cells(Target.Row, "A")                 h2.Cells(b.Row, "C") = h1.Cells(Target.Row, "C")                 h2.Cells(b.Row, "D") = h1.Cells(Target.Row, "D")                 h2.Cells(b.Row, "F") = h1.Cells(Target.Row, "F")                 h2.Cells(b.Row, "G") = h1.Cells(Target.Row, "G")                 h2.Cells(b.Row, "I") = h1.Cells(Target.Row, "N")                 MsgBox "Registro actualizado"             Else                 u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1                 h2.Cells(u, "A") = h1.Cells(Target.Row, "A")                 h2.Cells(u, "B") = h1.Cells(Target.Row, "B")                 h2.Cells(u, "C") = h1.Cells(Target.Row, "C")                 h2.Cells(u, "D") = h1.Cells(Target.Row, "D")                 h2.Cells(u, "E") = h1.Cells(Target.Row, "E")                 h2.Cells(u, "F") = h1.Cells(Target.Row, "F")                 h2.Cells(u, "G") = h1.Cells(Target.Row, "G")                 h2.Cells(u, "H") = h1.Cells(Target.Row, "I")                 h2.Cells(u, "I") = h1.Cells(Target.Row, "N")                 h2.Cells(u, "N") = h1.Cells(Target.Row, "Y")                 h2.Cells(u, "O") = h1.Cells(Target.Row, "S")                 MsgBox "Registro creado"             End If         End If     End If End Sub

1 respuesta

Respuesta
1

Quita la macro que estás ocupando y pon esta macro en un módulo y la asignas a aun botón:

Sub actualizar()
'Por.Dante Amor
    Set l1 = ThisWorkbook
    Set h1 = l1.ActiveSheet
    Set l2 = Workbooks("Archivo tm")
    Set h2 = l2.Sheets("Inventario ")
    '
    For i = 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
        Set r = h2.Columns("B")
        Set b = r.Find(h1.Cells(i, "B"), lookat:=xlWhole)
        pos = h1.Cells(i, "I")
        existe = False
        If Not b Is Nothing Then
            ncell = b.Address
            Do
                If h2.Cells(b.Row, "H") = pos Then
                    existe = True
                    Exit Do
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> ncell
        Else
            existe = False
        End If
        If existe Then
            h2.Cells(b.Row, "A") = h1.Cells(i, "A")
            h2.Cells(b.Row, "C") = h1.Cells(i, "C")
            h2.Cells(b.Row, "D") = h1.Cells(i, "D")
            h2.Cells(b.Row, "F") = h1.Cells(i, "F")
            h2.Cells(b.Row, "G") = h1.Cells(i, "G")
            h2.Cells(b.Row, "I") = h1.Cells(i, "N")
        Else
            u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
            h2.Cells(u, "A") = h1.Cells(i, "A")
            h2.Cells(u, "B") = h1.Cells(i, "B")
            h2.Cells(u, "C") = h1.Cells(i, "C")
            h2.Cells(u, "D") = h1.Cells(i, "D")
            h2.Cells(u, "E") = h1.Cells(i, "E")
            h2.Cells(u, "F") = h1.Cells(i, "F")
            h2.Cells(u, "G") = h1.Cells(i, "G")
            h2.Cells(u, "H") = h1.Cells(i, "I")
            h2.Cells(u, "I") = h1.Cells(i, "N")
            h2.Cells(u, "N") = h1.Cells(i, "Y")
            h2.Cells(u, "O") = h1.Cells(i, "S")
        End If
    Next
    MsgBox "Proceso terminado", vbInformation, "ACTUALIZACIÓN"
End Sub

Sigue las Instrucciones para un botón y ejecutar la macro

  1. Abre tu libro de Excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. En el menú elige Insertar / Módulo
  4. En el panel del lado derecho copia la macro
  5. Ahora para crear un botón, puedes hacer lo siguiente:
  6. Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
  7. Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
  8. Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona: Tamaño y Propiedades. En la ventana que se abre selecciona la pestaña: Propiedades. Desmarca la opción “Imprimir Objeto”. Presiona “Cerrar”
  9. Vuelve a presionar click derecho dentro de la imagen y ahora selecciona: Asignar macro. Selecciona: actualizar
  10. Aceptar.
  11. Para ejecutarla dale click a la imagen.

Saludos. Dante Amor

si muchas gracias así queda muy bien, solo que ella se queda procesando y no me dice en que momento termina solo al instante que le doy esc, ella se detiene sale una ventana donde le doy finalizar, pero en realidad no se todo el proceso queda terminado.

Gracias  

Si tienes muchos registros se va a tardar un poco, debes esperar a que aparezca el mensaje de proceso terminado

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas