recopier données d'une feuille a une autre et ajouter un filtre

saverloo

XLDnaute Occasionnel
bonjour,

je voudrais copier 3 colonnes d'une feuille ensuite les collée en format valeur sur une autre et ensuite appliquer un filtre sur cette page.
lorsque je lance la macro il ne recopie pas toutes les données des cellules et je n'arrive pas a trouver la solution a ceci.

voila la macro et au besoin je veux bien envoyer mon fichier sur un site ou par email car celui ci fait 3 MO donc ne passe pas ici

je vois en faite qu'il copie les reference reprise dans la macro mais ne tiens pas compte des nouvelles reference si il y a ou des modification du copier coller dans l'affichage. je me demande comment l'obliger a bien tenir compte de toutes les références avant le filtre car lorsque j'ouvre le filtre je vois qu'il tiens compte de la suppression des lignes vierges et des NA mais les produits modifier ou les nouveaux produits il y a pas de V devant le nom en FILTRE ?




Sub recaplundi()
'
' recaplundi Macro
'

'
Sheets("recapcomlundi").Select
Selection.AutoFilter
Range("A14:C1042").Select
Selection.ClearContents
Range("A13").Select
Sheets("LUNDI").Select
Range("AC10:AD1000").Select
Selection.Copy
Sheets("recapcomlundi").Select
Range("A14").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("F12").Select
Sheets("LUNDI").Select
Range("AB10:AB1000").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("recapcomlundi").Select
Range("C14").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("A14:C14").Select
Sheets("LUNDI").Select
Range("X3").Select
Sheets("recapcomlundi").Select
Range("A14:C1000").Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveSheet.Range("$A$14:$C$1000").AutoFilter Field:=1, Criteria1:=Array( _
"1051", "1198", "1221", "3720", "3851", "4634", "5440", "6314", "6335", "66", "7422", _
"7423", "7496", "7575", "7610", "7667", "7747", "7944", "7989", "8194", "8199", "8298", _
"8305", "8591", "8713", "8917", "9108", "9266", "9291", "9310", "9375", "9380", "9394", _
"9454", "9477", "9516", "9571", "9572", "9647", "9648", "9698", "9734", "9759", "9777", _
"984", "9902", "9917", "9982", "9987", "="), Operator:=xlFilterValues
ActiveSheet.Range("$A$14:$C$1000").AutoFilter Field:=1, Criteria1:=Array( _
"1051", "1198", "1221", "3720", "3851", "4634", "5440", "6314", "6335", "66", "7422", _
"7423", "7496", "7575", "7610", "7667", "7747", "7944", "7989", "8194", "8199", "8298", _
"8305", "8591", "8713", "8917", "9108", "9266", "9291", "9310", "9375", "9380", "9394", _
"9454", "9477", "9516", "9571", "9572", "9647", "9648", "9698", "9734", "9759", "9777", _
"984", "9902", "9917", "9982", "9987"), Operator:=xlFilterValues
Range("D20").Select
ActiveWindow.ScrollRow = 1
Range("D7").Select
Sheets("LUNDI").Select
Range("V3").Select
End Sub
 
Dernière édition:

saverloo

XLDnaute Occasionnel
Re : message erreur la méthode de autofiltre de la calsse RANGE a echoué

je ne sais pas mettre le fichier sur le site car celui ci fait 2,8 M mais si quelqu'un sais me dire ou je peux le mettre comme par exemple CI-JOINT qui d'après ce que je vois n'est plus actif je peux le mettre a disposition

je dois trouver une solution pour lundi matin pour ceci donc assez urgent et cela fait 2 jours que j'essai

merci d'avance
 

saverloo

XLDnaute Occasionnel
Re : message erreur la méthode de autofiltre de la calsse RANGE a echoué

voici en annexe un fichier basic mais qui montre bien mon problème
 

Pièces jointes

  • testbasicfichier.xlsm
    51.6 KB · Affichages: 21
  • testbasicfichier.xlsm
    51.6 KB · Affichages: 25
  • testbasicfichier.xlsm
    51.6 KB · Affichages: 23

MichD

XLDnaute Impliqué
Re : recopier données d'une feuille a une autre et ajouter un filtre

Bonjour,

Attache cette macro à ton bouton :

VB:
Sub test()
Dim DerLig As Long, T As Variant
Dim Dic As Object, Rg As Range
Dim C As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

With Feuil2 'Worksheets("recapcomlundi")
    If .FilterMode = True Then
        .ShowAllData
    End If
    .Range("A:C").ClearContents
End With

With Feuil1 'Sheets("Lundi")
    With .Range("AB10:AD1000")
        Feuil2.Range("A14").Resize(.Rows.Count, .Columns.Count) = .Value
    End With
    Set Rg = .Range("AC7:AC" & .Range("AC65536").End(xlUp).Row)
End With
With Feuil2
    With .Range("A14:A" & .Range("A65536").End(xlUp).Row)
        Application.DisplayAlerts = False
        .Resize(, 3).SpecialCells(xlCellTypeBlanks).Delete
        Application.DisplayAlerts = True
    End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
For Each C In Rg
    If C <> "" Then
        If Not Dic.Exists(C.Value) Then
            Dic.Add C.Value, C.Address
        End If
    End If
Next
T = Dic.Keys
With Feuil2
    With .Range("A:C")
        DerLig = .Find("*", LookIn:=xlValues, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious).Row
    End With
    With .Range("A13:C" & DerLig)
        .AutoFilter field:=2, Criteria1:=T, Operator:=xlFilterValues
    End With
End With
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
 

saverloo

XLDnaute Occasionnel
Re : recopier données d'une feuille a une autre et ajouter un filtre

merci pour ton aide mais il me met une erreur au niveau de la ligne RANGE A C clear ?

et lorsque je lance il indique erreur 1004



Sub recaplundi()

'Dim DerLig As Long, T As Variant
Dim Dic As Object, Rg As Range
Dim C As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

With Feuil2 'Worksheets("recapcomlundi")
If .FilterMode = True Then
.ShowAllData
End If
.Range("A:C").ClearContents
End With

With Feuil1 'Sheets("Lundi")
With .Range("AB10:AD1000")
Feuil2.Range("A14").Resize(.Rows.Count, .Columns.Count) = .Value
End With
Set Rg = .Range("AC7:AC" & .Range("AC65536").End(xlUp).Row)
End With
With Feuil2
With .Range("A14:A" & .Range("A65536").End(xlUp).Row)
Application.DisplayAlerts = False
.Resize(, 3).SpecialCells(xlCellTypeBlanks).Delete
Application.DisplayAlerts = True
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
For Each C In Rg
If C <> "" Then
If Not Dic.Exists(C.Value) Then
Dic.Add C.Value, C.Address
End If
End If
Next
T = Dic.Keys
With Feuil2
With .Range("A:C")
DerLig = .Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End With
With .Range("A13:C" & DerLig)
.AutoFilter field:=2, Criteria1:=T, Operator:=xlFilterValues
End With
End With
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub
 

MichD

XLDnaute Impliqué
Re : recopier données d'une feuille a une autre et ajouter un filtre

Dans le fichier que tu as publié, dans la feuille "Lundi",
à partir de la ligne 160 colonnes AB - AD, tu as des valeurs
#DIV/0!

Débute par supprimer ces valeurs d'erreur et teste à nouveau!
 

Pièces jointes

  • test basic fichier.xlsm
    26.8 KB · Affichages: 37
Dernière édition:

Discussions similaires