Aide sur une macro

Bonjour,

Je cherche à simplifier une macro faite en partie avec l'enregistreur (je sais ... c'est pas bien )

mais je galère avec un copier-coller de cellules visibles uniquement pour récupérer le résultat d'un filtre

Si quelqu’un pouvais m'aider

Merci d'avance

'Filtre pour enlever les produits non commandés'
Sheets("Feuil1").Select
Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$B$1:$B$46").AutoFilter Field:=1, Criteria1:=">0", _
        Operator:=xlAnd

'copier feuille 1- coller feuille 2'
Sheets("Feuil2").Range("A2:B160").Value = Sheets("Feuil1").Range("A1:B160").SpecialCells(xlCellTypeVisible).Value

Pour copier les données , l'enregistreur de macro me donne

Range("A2:B160").Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Sheets("Feuil2").Select
    Range("A2:B160").Select
    ActiveSheet.Paste

mais j'ai mal du integrer la selection spéciale sur mon code.

Bonjour,

Il serait bon, lorsque tu cites du code, de ne pas tronquer la déclaration de procédure (Sub... End Sub), cela permet d'être sûr que le code de la procédure est complet. Et même d'ajouter les déclarations niveau module lorsqu'elle ont un impact ou un lien avec l'exécution de la procédure...

Par ailleurs, pour ne pas avoir à épurer du code enregistré, le plus simple est de l'écrire directement , mais il n'est pas compliqué de faire l'épuration de base (suppression des Select, Selection, Activate, etc.), et (sans réfléchir) toujours supprimer la ligne Application.CutCopyMode=False (si jamais tu pouvais en avoir besoin, elle n'aurait pas été enregistrée...)

Je ne vais pas te faire l'illustration, car la copie avec SpecialCells n'est pas forcément ce qu'il y a de mieux, et dans ton cas, le filtre avancé pourrait s'avérer plus pratique et simple d'emploi.

Sous réserve toutefois que tes indications permettent de cerner exactement la configuration de tes données (autrement la fourniture d'un classeur s'impose...)

Sub Neilah()
    With Worksheets("Feuil1")
        .Range("X1") = .Range("B1"): .Range("X2") = ">0"
        .Range("A1:B160").AdvancedFilter xlFilterCopy, .Range("X1:X2"), _
         Worksheets("Feuil2").Range("A1:B1")
        .Range("X1:X2").ClearContents
    End With
End Sub

Pour explication : on crée une zone de critère en X, dans laquelle on reproduit en 1re ligne le libellé de champ B1 (sur lequel tu filtres) et en 2e ligne le critère de filtrage. [J'espère que cette zone est inoccupée !]

On applique un filtre avancé àla plage A1:B160 (petite interrogation sur 46 ou 160, mais l'extension sur une zone vide n'aura pas d'incidence) avec les paramètres suivants : copie sur un autre emplacement, indication de la zone de critère, indication de l'emplacement de la copie.

Pour finir, on efface la zone de critère...

Cordialement.

J'ai continué à travailler sur l'épuration du code mais j'arrive toujours à rien faire avec la partie dont je parlais. Cdlt

Sub Pac()
'Suppression données provisoires'
Sheets("Feuil1").Cells.Clear
Sheets("Feuil2").Cells.Clear
'Copie du nom de magasin'
Sheets("Bon de Livraison").Range("F4").Value = Sheets("Feuille Semaine").Range("B1").Value
'copie designation feuille Semaine'
'Collage designation Intermédiaire BL'
Sheets("Feuil1").Range("A1:A115").Value = Sheets("Feuille Semaine").Range("A50:A165").Value
'copie quantité feuille Semaine'
'Collage quantité Intermédiaire BL"
Sheets("Feuil1").Range("B1:B115").Value = Sheets("Feuille Semaine").Range("B50:B165").Value
'Filtre pour enlever les produits non commandés'
Sheets("Feuil1").Select
Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$B$1:$B$120").AutoFilter Field:=1, Criteria1:=">0", _
        Operator:=xlAnd

Sheets("Feuil1").Select
    Range("A2:B112").Select
    Selection.Copy
    Sheets("Feuil2").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Copie dans le bon de livraison'
Sheets("Bon de Livraison").Range("E10:E130").Value = Sheets("Feuil2").Range("A1:A120").Value
Sheets("Bon de Livraison").Range("C10:C130").Value = Sheets("Feuil2").Range("B1:B120").Value

'Copie dans les archives(dans la première ligne vide)'
Sheets("Feuil2").Select
    Range("A1:B165").Select
    Selection.Copy
    Sheets("Archive Bl Pac Surg").Select
       Range("B1").Select
Do While ActiveCell.Value > ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
'Impression du bon de livraison (page 1)'
Sheets("Bon de Livraison").PrintOut From:=1, To:=1
'Retour à la feuille Semaine'
Sheets("Feuille Semaine").Select

End Sub

Ton code n'a vraiment rien d'épuré.

Je serais fort curieux de te voir en justifier chaque ligne !

Bonne soirée.

Bonjour,

Je suis très limité au niveau de mes connaissances VBA comme tu as pû t'en rendre compte ... mais je ne demande qu'à apprendre

Je sais que mon code n'a rien a voir avec celui d'un expert mais il a quand même évolué depuis l'enregistreur de macro ! sur tes conseil j'ai enlevé tout les Select, Activate ... que je pouvais mais là ... dès que j’essaie quelque chose, ça plante : je dois définir mes onglets avec un "Dim Ws as" non ?

Si tu as la patience de faire quelque chose pour moi.

Cdlt

Patrick

Bonjour,

Sub Pac()
    Dim wsBL As Worksheet, n%
    Worksheets("Feuil1").UsedRange.ClearContents
    Worksheets("Feuil2").UsedRange.ClearContents
    Set wsBL = Worksheets("Bon de Livraison")
    Application.ScreenUpdating = False
    With Worksheets("Feuille Semaine")
        wsBL.Range("F4") = .Range("B1")
        Worksheets("Feuil1").Range("A1:B116").Value = .Range("A50:B165").Value
    End With
    With Worksheets("Feuil1")
        .Range("X1") = .Range("B1"): .Range("X2") = ">0"
        .Range("A1:B160").AdvancedFilter xlFilterCopy, .Range("X1:X2"), _
         Worksheets("Feuil2").Range("A1:B1")
        .Range("X1:X2").ClearContents
    End With
    With Worksheets("Feuil2")
        n = .Range("B" & .Rows.Count).End(xlUp).Row
        wsBL.Range("E10").Resize(n).Value = .Range("A1").Resize(n).Value
        wsBL.Range("C10").Resize(n).Value = .Range("B1").Resize(n).Value
        Worksheets("Archive Bl Pac Surg").Range("B" & Rows.Count).End(xlUp).Offset(1) _
         .Resize(n, 2).Value = .Range("A1").Resize(n, 2).Value
    End With
    wsBL.PrintOut 'From:=1, To:=1
    Worksheets("Feuille Semaine").Activate
End Sub

Je te rappelle que cette réécriture est réalisée sans fichier...

Alors, inutile de venir dire que cela ne fonctionne pas si tu ne déposes pas le fichier en cause !

Cordialement.

Un immense merci,

après quelques modifications minimes le code marche parfaitement

Cdlt

Patrick