XL 2016 Filtre intervalle date + cellule vide sur tableau

Alex6942

XLDnaute Nouveau
Bonjour à tous ,

Je souhaiterais filtrer automatiquement un tableau contenue dans un onglet nommé "Coller"

La dimension du tableau est assez large ; (57 colonnes , de [A] à [BE] ) et comptant + de 80000 lignes

Il faudrait :
- Un premier filtre "intervalle de date" filtrant la colonne [AI] (A partir de deux dates saisies manuellement sur un autre onglet nommé "Tableau de bord")
- Un filtre n'affichant que les cellule vide en colonne [AQ]
- Et copier coller le tableau filtré sur un onglet nommé "Coller" afin de ne garder que les donnés filtrées

Si vous avez des bout de codes à adapter , je suis preneur :)

Cordialement,
 

danielco

XLDnaute Accro
Bonjour,

1.
VB:
  Dim Plage As Range, Ligne As Long
  With Sheets("Coller")
    Ligne = .[A:BE].Find("*", , , , xlByRows, xlPrevious).Row
    Set Plage = .Range("A1:BE" & Ligne)
  End With
  With Sheets("Tableau de bord")
    Plage.AutoFilter
    Plage.AutoFilter 35, ">=" & .[A1].Value2, xlAnd, "<=" & .[B1].Value2
  End With
2.
Code:
  Dim Plage As Range, Ligne As Long, Sh As Worksheet
  With Sheets("Coller")
    Ligne = .[A:BE].Find("*", , , , xlByRows, xlPrevious).Row
    Set Plage = .Range("A1:BE" & Ligne)
  End With
  With Sheets("Tableau de bord")
    Plage.AutoFilter
    Plage.AutoFilter 43, ""
  End With
  With Sheets("Coller")
    Set Sh = Sheets.Add
    Plage.SpecialCells(xlCellTypeVisible).Copy Sh.[A1]
    Plage = ""
    Plage.AutoFilter
    With Sh
      .Range("A1", .Cells(.Rows.Count, "BE").End(xlUp)).Copy [Coller!A1]
    End With
    Application.DisplayAlerts = False
    Sh.Delete
    Application.DisplayAlerts = True
  End With

Cordialement.

Daniel
 

Alex6942

XLDnaute Nouveau
Bonjour,

1.
VB:
  Dim Plage As Range, Ligne As Long
  With Sheets("Coller")
    Ligne = .[A:BE].Find("*", , , , xlByRows, xlPrevious).Row
    Set Plage = .Range("A1:BE" & Ligne)
  End With
  With Sheets("Tableau de bord")
    Plage.AutoFilter
    Plage.AutoFilter 35, ">=" & .[A1].Value2, xlAnd, "<=" & .[B1].Value2
  End With
2.
Code:
  Dim Plage As Range, Ligne As Long, Sh As Worksheet
  With Sheets("Coller")
    Ligne = .[A:BE].Find("*", , , , xlByRows, xlPrevious).Row
    Set Plage = .Range("A1:BE" & Ligne)
  End With
  With Sheets("Tableau de bord")
    Plage.AutoFilter
    Plage.AutoFilter 43, ""
  End With
  With Sheets("Coller")
    Set Sh = Sheets.Add
    Plage.SpecialCells(xlCellTypeVisible).Copy Sh.[A1]
    Plage = ""
    Plage.AutoFilter
    With Sh
      .Range("A1", .Cells(.Rows.Count, "BE").End(xlUp)).Copy [Coller!A1]
    End With
    Application.DisplayAlerts = False
    Sh.Delete
    Application.DisplayAlerts = True
  End With

Cordialement.

Daniel

Pour le code 1 : OK pour la partie filtrer dans un intervalle de temps à partir de deux dates.

Pour le code 2 : J'ai des problèmes , le copier coller ouvre un nouvel onglet Feuil15 , puis Feuil 16 , ainsi de suite au lieu de coller dans un autre onglet. De plus , je perd le filtre de date en [AI]. Cela ne prend en compte que les cellules vides en [AQ]
J'ai essayé de comprendre le code et d'éxuter en mode pas à pas , mais je n'y comprend pas grand chose sur ce coup .. Pourquoi rappel-t-on la feuille Tableau de bord ? Pourquoi crée t-on un onglet Sh pour ensuite le supprimer ?

Cordialement,
 

Alex6942

XLDnaute Nouveau
Danielco ,

Exactement ,

Etape 1 : Filtre colonne [AI] à partir d'un intervalle de date
Etape 2 : Filtre colonne [AQ] a partir du contenu vide d'une cellule
Etape 3 : remplacer le tableau filtré par le même sans les cellules masqués

Execution du code 1 : Me filtre que l'intervalle de date voulu : OK

Execution du code 2 : Me recopie le tableau comme a l'initial (plus de filtre sur les jours , et mise en avant des cellules vides (en premier) , mais les autres lignes ressortent encore..
 

danielco

XLDnaute Accro
Essaie :

VB:
  Dim Plage As Range, Ligne As Long, C As Range
  With Sheets("Coller")
    Ligne = .[A:BE].Find("*", , , , xlByRows, xlPrevious).Row
    Set Plage = .Range("A1:BE" & Ligne)
    Plage.AutoFilter
    Application.ReplaceFormat.NumberFormat = "0"
    Intersect(Plage, .[AQ:AQ]).Replace "", 0, xlWhole, ReplaceFormat:=True
    .AutoFilter.Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:= _
      Intersect(Plage, .[AQ:AQ]), SortOn:=xlSortOnValues, Order:=xlAscending, _
      DataOption:=xlSortTextAsNumbers
    With .AutoFilter.Sort
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
    Intersect(Plage, .[AQ:AQ]).Replace 0, "", xlWhole
  End With

Daniel
 

Alex6942

XLDnaute Nouveau
Essaie :

VB:
  Dim Plage As Range, Ligne As Long, C As Range
  With Sheets("Coller")
    Ligne = .[A:BE].Find("*", , , , xlByRows, xlPrevious).Row
    Set Plage = .Range("A1:BE" & Ligne)
    Plage.AutoFilter
    Application.ReplaceFormat.NumberFormat = "0"
    Intersect(Plage, .[AQ:AQ]).Replace "", 0, xlWhole, ReplaceFormat:=True
    .AutoFilter.Sort.SortFields.Clear
    .Sort.SortFields.Add2 Key:= _
      Intersect(Plage, .[AQ:AQ]), SortOn:=xlSortOnValues, Order:=xlAscending, _
      DataOption:=xlSortTextAsNumbers
    With .AutoFilter.Sort
      .Header = xlYes
      .MatchCase = False
      .Orientation = xlTopToBottom
      .SortMethod = xlPinYin
      .Apply
    End With
    Intersect(Plage, .[AQ:AQ]).Replace 0, "", xlWhole
  End With

Daniel
Bonjour,

j'ai l'erreur ci-jointe :
1617771631136.png


ERREUR D’EXÉCUTION 438

Cordialement,
 

danielco

XLDnaute Accro
Essaie comme ça, pour voir :

VB:
  Dim Plage As Range, Ligne As Long, C As Range
  With Sheets("Coller")
    Ligne = .[A:BE].Find("*", , , , xlByRows, xlPrevious).Row
    Set Plage = .Range("A1:BE" & Ligne)
    Plage.AutoFilter
    Application.ReplaceFormat.NumberFormat = "0"
    Intersect(Plage, .[AQ:AQ]).Replace "", 0, xlWhole, ReplaceFormat:=True
    Intersect(Plage, .[AQ:AQ]).Sort .[AQ1], xlAscending, Header:=xlYes
    Intersect(Plage, .[AQ:AQ]).Replace 0, "", xlWhole
  End With

Daniel
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 900
Membres
101 834
dernier inscrit
Jeremy06510