Saltar al contenido

Macro con ciclo repetitivo

publicado

 

Buen dia 

Tengo la siguiente macro en la cual debo ir filtrando cada una de las columnas, con valores y las demas en ceros para poder sacar la suma y copiarla en la parte superior, y asi ir recorriendo todas las columnas, en la siguiente la columna 5 ya no hago nada y a la 6 la filtro con los <> a cero, esto lo quiero meter en un ciclo pero no he podido, creeria que seria un for e ir eliminando de una columna en cada nuevo ciclo hasta llegar al ultimo, si tienen alguna idea de como lo podria realizar, les agradezco

 

 este es parte del codigo que tengo hoy en dia manual, pero para que vean que en el siguiente va saliendo una columna.

ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=5, Criteria1:="<>0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=6, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=7, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=8, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=9, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=10, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=11, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=12, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=13, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=14, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=15, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=16, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=17, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=18, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=19, Criteria1:="0"


    'suma
        Range("E10").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("E11").Select
    Selection.End(xlDown).Select
    Range("E498").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-482]C:R[-2]C)"
    Range("E498").Select
    Selection.Copy
    Selection.End(xlUp).Select
    Range("E9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 

 'filtro
    Rows("11:11").Select
    ActiveSheet.ShowAllData
    Range("A10").Select
    
    ' 2do ciclo 


ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=6, Criteria1:="<>0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=7, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=8, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=9, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=10, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=11, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=12, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=13, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=14, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=15, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=16, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=17, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=18, Criteria1:="0"
ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=19, Criteria1:="0"

 

Gracias 

 

Featured Replies

publicado

Hola... 

Sub Filtro()
Dim n&, cCriterio$
    For n = 5 To 19
        If n = 5 Then cCriterio = "<>0" Else cCriterio = "0"
        ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=n, Criteria1:=cCriterio
    Next n
    'suma
        Range("E10").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("E11").Select
    Selection.End(xlDown).Select
    Range("E498").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[-482]C:R[-2]C)"
    Range("E498").Select
    Selection.Copy
    Selection.End(xlUp).Select
    Range("E9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'filtro
    Rows("11:11").Select
    ActiveSheet.ShowAllData
    Range("A10").Select
    
    ' 2do ciclo

    For n = 6 To 19
        If n = 6 Then cCriterio = "<>0" Else cCriterio = "0"
        ActiveSheet.Range("$A$11:$AH$434").AutoFilter Field:=n, Criteria1:=cCriterio
    Next n

End Sub

Saludos.

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas