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

CGU2022.

XLDnaute Nouveau
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 ......
 
Solution
Mon souhait remettre le filtre à l'identique après l'exécution de la macro qu'il soit actif ou pas ....

A tester :
VB:
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

XLDnaute Barbatruc
Supporter XLD
Bonjour,

à tout hasard (indépendant de l'existence d'un filtre ou pas - ou du type de filtrage)
VB:
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
 
Dernière édition:

TooFatBoy

XLDnaute Barbatruc
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

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

A tester :
VB:
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

XLDnaute Barbatruc
Supporter XLD
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 :
VB:
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

XLDnaute Barbatruc
Bonjour à tous

@christophe.garrigou@gmail

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

VB:
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

XLDnaute Barbatruc
Supporter XLD
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.

XLDnaute Nouveau
A tester :
VB:
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.

XLDnaute Nouveau
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

XLDnaute Barbatruc
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 ? 🤔
 

Discussions similaires