Suppresion de filtres dans macro existante

Bonjour le forum !

J'ai un tout petit topic pour vous, je n'y connais toujours pas grand chose en VBA et j'ai beau avoir testé toutes les solutions possible, ça ne fonctionne pas...

Je cherche à intégrer quelques lignes dans une macro existante.... La macro que Banzai64 m'a faite la semaine dernière fonctionne très bien quand le tableau de base ne comprend pas de filtres, mais à partir du moment où il y en a un... Ca ne fonctionne plus :-/

Voilà ce que je souhaite intégrer comme code pour supprimer les filtres de la feuille "Hiérarchisation_AE" :

On Error Resume Next
ActiveSheet.ShowAllData

Et voila la macro avec laquelle j'aimerai bien l'associer, sachant qu'elle est positionnée sur le feuille nomme "Synthèse" :

Sub Recopie()
Dim J As Long, NbLg As Long
Dim F1 As Worksheet, F2 As Worksheet

  Application.ScreenUpdating = False

  Set F1 = Sheets("Hiérarchisation_AE")
  Set F2 = Sheets("Synthèse")
  If F2.Range("A10") <> "" Then
    F2.Range("A10:AN" & F2.Range("A" & Rows.Count).End(xlUp).Row).ClearContents
  End If
  If F2.Range("BA10") <> "" Then
    F2.Range("B10:BE" & F2.Range("BA" & Rows.Count).End(xlUp).Row).ClearContents
  End If

  F1.Range("N33:BA" & F1.Range("N" & Rows.Count).End(xlUp).Row).Copy
  F2.Range("A10").PasteSpecial Paste:=xlPasteValues
  NbLg = F2.Range("A" & Rows.Count).End(xlUp).Row

  F2.Range("A10:AN" & NbLg).Sort Key1:=F2.Range("AN10"), Order1:=xlDescending, Header:=xlNo, _
                                 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                                 DataOption1:=xlSortNormal

  F2.Range("R2").Formula = "=AN10>='" & F1.Name & "'!$BB$28"
  F2.Range("A9:AN" & NbLg).AdvancedFilter Action:=xlFilterCopy, criteriarange:=F2.Range("R1:R2"), copytorange:=F2.Range("BA9:BE9")
  F2.Range("R2").ClearContents
  NbLg = F2.Range("BA" & Rows.Count).End(xlUp).Row
  If NbLg > 10 Then
    With Range("BF10:BF" & NbLg)
      .FormulaR1C1 = "=RC[-4]&RC[-3]&RC[-2]&RC[-1]"
      .Value = .Value
    End With

    F2.Range("BA10:BF" & NbLg).Sort Key1:=F2.Range("BF10"), Order1:=xlAscending, Header:=xlNo, _
                                    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                                    DataOption1:=xlSortNormal

    For J = NbLg To 11 Step -1
      If F2.Range("BF" & J) = F2.Range("BF" & J - 1) Then
        F2.Range("BA" & J - 1) = F2.Range("BA" & J - 1) & vbLf & F2.Range("BA" & J)
        F2.Range("BA" & J).Resize(1, 6).Delete shift:=xlShiftUp
      End If
    Next J
    F2.Range("BF10:BF" & NbLg).ClearContents
    F2.Columns("BA:BE").AutoFit
  End If

   Application.ScreenUpdating = True  
End Sub

Si quelqu'un veut bien jeter un oeil à mon problème, je lui en serais très reconnaissante !

Merci d'avance !

Bonjour

Rajoutes la ligne surlignée

  If F2.Range("BA10") <> "" Then
    F2.Range("B10:BE" & F2.Range("BA" & Rows.Count).End(xlUp).Row).ClearContents
  End If

  If F1.FilterMode = True Then F1.ShowAllData

  F1.Range("N33:BA" & F1.Range("N" & Rows.Count).End(xlUp).Row).Copy

Une fois de plus la solution au premier essai !

Merci !

Rechercher des sujets similaires à "suppresion filtres macro existante"