XL 2013 Copie filtre existant active macro remet le filtre à l'identique

[CGU2022.]

Bonjour à toutes et à tous.....

J'ai une macro qui copie et colle des valeurs de cellules.
Pour que cela marche je dois libérer le filtre exitant ActiveSheet.Range("$H$10:$H$2000").AutoFilter Field:=1

ci dessous la macro
Sub Cumul()

ActiveSheet.Range("$H$10:$H$2000").AutoFilter Field:=1 'libère le filtre qu'il soit
Range("k18:k1859").Copy 'copie la sélection colonne k
Range("I18").PasteSpecial Paste:=xlPasteValues 'colle la sélection à partir d'une cellule
Range("J18:J1859").ClearContents 'efface la colonne J


End Sub

Mon souhait remettre le filtre à l'identique après l'exécution de la macro qu'il soit actif ou pas ....


Cordialement ......

 

[CGU2022.]

Ci joint la ligne qui active le filtre

ActiveSheet.Range("$H$10:$H$2000").AutoFilter Field:=1, Criteria1:="<>"

 

[mapomme]

Bonjour,

à tout hasard (indépendant de l'existence d'un filtre ou pas - ou du type de filtrage)

Sub Cumul()
Dim i&
   Application.ScreenUpdating = False
   For i = 18 To 1859: Cells(i, "i") = Cells(i, "k"): Next i
   Range("J18:J1859").ClearContents
End Sub

 

[TooFatBoy]

Bonjour,

Ci joint la ligne qui active le filtre

ActiveSheet.Range("$H$10:$H$2000").AutoFilter Field:=1, Criteria1:="<>"

Ben il suffit de mettre cette ligne après ton Clear.Contents nan ???

[edit]
Ah ben non, il faut tester l'état du filtre de la colonne H en début de macro, et n'activer le filtre en fin de macro que s'il était actif au début...
[/edit]

 

[TooFatBoy]

Mon souhait remettre le filtre à l'identique après l'exécution de la macro qu'il soit actif ou pas ....

A tester :

Sub test()
'
Dim FiltreActif As Boolean

    FiltreActif = False
    On Error Resume Next
    FiltreActif = ActiveSheet.AutoFilter.Filters.Item(1).On
    ActiveSheet.Range("$H$10").AutoFilter Field:=1

    Range("k18:k1859").Copy
    Range("I18").PasteSpecial Paste:=xlPasteValues
    Range("J18:J1859").ClearContents

    If FiltreActif = True Then
        ActiveSheet.Range("$H$10:$H$2000").AutoFilter Field:=1, Criteria1:="<>"
    End If

End Sub

 

[mapomme]

Bonjour à Christop.... , à @TooFatBoy ,

Comme mon code du post #3 fonctionne avec n'importe quel filtrage, il faut après, avoir fait des modifications de données sur la plage, remettre à jour le filtrage pour tenir compte, le cas échéant, des changements de valeurs parmi les données des critères de filtrage. On rajoute donc une ligne :

Sub Cumul()
Dim i&
   Application.ScreenUpdating = False
   For i = 18 To 1859: Cells(i, "i") = Cells(i, "k"): Next i
   Range("J18:J1859").ClearContents
   If ActiveSheet.FilterMode Then ActiveSheet.AutoFilter.ApplyFilter
End Sub

 

[Phil69970]

Bonjour à tous

@christophe.garrigou@gmail

Ma façon de voir les choses ..... ou une autre manière de faire

Sub Cumul()
Dim TestF As Byte
If Not ActiveSheet.AutoFilter Is Nothing Then
    If ActiveSheet.FilterMode Then TestF = 1: ShowAllData
End If

[I18:I1859] = [k18:k1859].Value
[J18:J1859].ClearContents

If TestF = 1 Then ActiveSheet.[$H$10:$H$2000].AutoFilter Field:=1, Criteria1:="<>"
End Sub

Merci de ton retour

@Phil69970

 

[mapomme]

Comme je dois faire partie des tous, à mon tour de t'adresser un salut @Phil69970: Bonjour !

 

[Phil69970]

C'est vrai j'aurais pu (du) vous nommer

Bonjour @christophe.garrigou@gmail , @mapomme , @TooFatBoy

C'est chose faite

 

[mapomme]

C'est vrai j'aurais pu (du) vous nommer

Non, non ce n'est pas cela. C'est vraiment juste pour te saluer en ce samedi annoncé encore sans pluie. Une des conséquences du changement de climat : il va falloir revoir nos formules de politesse. On va bientôt se quitter en se souhaitant un week-end pluvieux et frais et ce sera bienveillant!

 

[CGU2022.]

A tester :

Sub test()
'
Dim FiltreActif As Boolean

    FiltreActif = False
    On Error Resume Next
    FiltreActif = ActiveSheet.AutoFilter.Filters.Item(1).On
    ActiveSheet.Range("$H$10").AutoFilter Field:=1

    Range("k18:k1859").Copy
    Range("I18").PasteSpecial Paste:=xlPasteValues
    Range("J18:J1859").ClearContents

    If FiltreActif = True Then
        ActiveSheet.Range("$H$10:$H$2000").AutoFilter Field:=1, Criteria1:="<>"
    End If

End Sub
[/cod
[/QUOTE]

 

[CGU2022.]

Bonjour, je n'ai pas eu le courage à lecture de vos alertes (par email) de rallumer et me replonger dans les vba le 5/08.
Mais c'est chose faite ce jour, je suis novice et bricole comme je peux.
Je trouve les vba très addictives et peuvent parfois m'amener jusqu'au petit matin (c'est très dur de s'endormir sans avoir trouvé la solution )

Un grand merci pour vos messages @Phil69970 , @mapomme , @TooFatBoy.

j'ai utilisé la sub de @Phil69970 (copier/coller).....

Encore un grand merci je vous souhaite un bon Weekend...(ombragé )

 

[TooFatBoy]

je suis novice et bricole comme je peux.
Je trouve les vba très addictives et peuvent parfois m'amener jusqu'au petit matin (c'est très dur de s'endormir sans avoir trouvé la solution )

Oh comme je te comprends !!!
(c'est tout pareil pour moi)

j'ai utilisé la sub de @Phil69970 (copier/coller).....

C'est sûr que sa solution fonctionne et est très bien.
Mais c'est peut-être un peu plus lent que ce que tu avais demandé. Non ?

 

[CGU2022.]

Je suis Désolé @TooFatBoy et @Phil69970 j'ai fait un ctrl+c ctrl+v sans relecture.


Erratum
j'ai utilisé la sub de @Phil69970 (copier/coller).....
Veuillez lire
j'ai utilisé la sub de @TooFatBoy (copier/coller).....

Merci Phil69970 pour ta réactivité....

 

[TooFatBoy]

Par ces chaleurs, c'est bien de beaucoup boire. Mais faudrait se limiter à de l'eau...