Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Macro

Excel - Macro

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil
Val: 14
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macro

Publicado por Leo (7 intervenciones) el 23/06/2019 15:44:45
Buenos días, Necesito hacer una macro que me borre las facturas que tengan como condición la Palabra PAGADA, pero que antes de borrarlas me haga una copia en otra hoja de Excel. Para que se me quede guardado ese registro. La tabla cuenta con 13 columnas.
1-Cliente
2- Numero de factura
3- Monto
4- Calificacion
5-Fecha de factura
6- Fecha de cobro
7- Dias vencidos
8-Zona
9- Monto pagado
10-fecha de pago
11- Recibo
12- Forma de pago
13- Condicion
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macro

Publicado por Antoni Masana (2540 intervenciones) el 25/06/2019 08:17:02
La macro:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Sub Eliminar_Pagada()
    Dim Fila_Orig As Long, Fila_Dest As Long, Col As Byte
 
    ' ---&--- Busca la primera fila vacia del destino

 
    Sheets("Pagada").Select
    Fila_Dest = 2
    While Cells(Fila_Dest, "A") <> ""
        Fila_Dest = Fila_Dest + 1
    Wend
 
    Sheets("Programa").Select
 
    Fila_Orig = 12
    While Cells(Fila_Orig, "A") <> ""
 
        ' ---&--- Si esta PAGADO

 
        If UCase(Cells(Fila_Orig, "N")) = "PAGADA" Then
 
           ' ---&--- Copia la linea

 
           For Col = 1 To 14
               Sheets("Pagada").Cells(Fila_Dest, Col) = Cells(Fila_Orig, Col)
           Next
           Fila_Dest = Fila_Dest + 1
 
           ' ---&--- Borra la linea del origen y sigo en la misma linea

 
           Rows(Fila_Orig & ":" & Fila_Orig).Select
           Selection.Delete Shift:=xlUp
        Else
           Fila_Orig = Fila_Orig + 1  ' Salto a la siguiente

        End If
    Wend
End Sub

Adjunto libro con macro


Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar