XL 2016 Filtre intervalle date + cellule vide sur tableau

[Alex6942]

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]

Bonjour,

1.

  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.

  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]

Bonjour,

Merci pour ton retour, je regarde cela Mardi au travail. Je n'ai pas le fichier avec moi là.

Cordialement,

 

[Alex6942]

Bonjour,

1.

  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.

  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,

 

[danielco]

J'ai peut-être mal compris. Tu demandes de copier un tablau filtré se trouvant sur la feuille COLLER et de coller ce tableau sur la même feuille COLLER. C'est ce que fait mon code, sauf erreur ?

Daniel

 

[Alex6942]

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]

Est-ce que tu peux mettre en PJ un classeur de test ? (Pas toutes les lignes)

Daniel

 

[Alex6942]

Ci-joint avec quelques lignes ... 1000 environs...

 

[danielco]

Essaie :

  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]

Essaie :

  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 :

ERREUR D’EXÉCUTION 438

Cordialement,

 

[danielco]

Tu es sûr que ta version d'Excel est 2016 ?

Daniel

 

[Alex6942]

Oui

 

[danielco]

Essaie comme ça, pour voir :

  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

 

[Alex6942]

Je ne vois plus la différence entre l'avant et l’après macro.. Je lance bien juste ce bout de code la ? ou c'est une partie a remplacer du code total ? ..

 

[danielco]

Non, ça remplace celui que je t'avais fourni.

Daniel