XL 2016 simplifier avec boucle la macro de l'enregistreur de macro

P

PASCAL84810

XLDnaute Junior
bonjour,

je dois filtrer à tour de rôle des colonnes de droite à gauche et relever le nombre sous total de la colonne filtrée et la somme sous total de la 4 ème colonnes.
je voudrais simplifier avec une boucle style colonne -1 jusqu'a colonne 7, mais je ne sais pas faire.
je joins également un fichier

merci pour votre aide,
pascal

l'enregistreur donne pour les deux premières colonnes:

Macro5 Macro
'
'
ActiveSheet.Range("$A$1:$AS$1248").AutoFilter Field:=44, Criteria1:=">-24" _
, Operator:=xlAnd
Range("ci2").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(3,C[-43])-1"
Range("ci3").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,C[-82])"


Range("ci2:ci3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("$A$1:$AS$1248").AutoFilter Field:=43, Criteria1:=">-24" _
, Operator:=xlAnd
Range("ch2").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(3,C[-42])-1"
Range("ch3").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,C[-81])"
Range("ch2:ch3").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End Sub
 

Pièces jointes

  • Classeur1 simplification macro.xlsm
    12.9 KB · Affichages: 55
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re

Décidément...
Je parle juste de la macro Filtrer, je m'occupe pas du reste pour le moment.
J'ai bien précisé (si on désactive les procédures événementielles pour tester) et qu'on lance ta version qu'on note ce qui se passe alors.
Puis qu'on repart de la situation initiale et qu'on teste ma syntaxe on note le même résultat que ta macro, non ?
C'est à cette seule et simple question qu'était dédié le message#11.
 
Vote positif 0 Vote négatif
P

PASCAL84810

XLDnaute Junior
Bonjour

je vous joins le fichier en entier cela sera plus facile à comprendre,
le résultat attendu est : à date, combien j'ai de références et quantités d'articles en stock non vendu depuis le mois n-1, n-2, n-3, etc. (hors échantillon d'ou les -24)
ensuite je retravaille en pourcentage de stock et propose des solutions correctives .
j'ai 30 familles de produits où je dois faire la même chose. Chaque mois.
je ne vois pas comment construire un TCD pour apporter ce résultat sinon je l'aurais fait.
si vous avais une solution TCD je suis preneur.
Merci
Cordialement
Pascal
 

Pièces jointes

  • test macro rotation nul.xlsm
    461.3 KB · Affichages: 28
Vote positif 0 Vote négatif
gosselien

gosselien

XLDnaute Barbatruc
Bonjour,
je dois avouer que je je comprends RIEN (mais c'est souvent comme ça)
Avec un exemple d'un seul article ou 2-3) et le AVANT/APRES on y verrait + clair non ? avec stock départ et différent mouvement sur différents mois...

P.

ps: je suivrai mais je passe mon tour, trop complexe pour moi :(
 
Vote positif 0 Vote négatif
P

PASCAL84810

XLDnaute Junior
Bonjour,

voici le code que je viens de développer (avec le générateur d'enregistrement) pour avoir une macro qui fonctionne bien.
c'est là que l'on peut voir pour le réduire si cela vous tente.

je vous joins le fichier avec le VBA car tout ne rentre pas dans le message
en tout cas merci à tous pour vous être penché sur le problème et pour votre temps passé dessus.
cordialement
Pascal

VB: 
Sub FILTRAGE_ET_RECOPIE()
'
' FILTRAGE_ET_RECOPIE Macro
'
Dim plage As Range
    Range("CI2").Select
    ActiveCell.FormulaR1C1 = "=SUBTOTAL(3,C[-44])-1"
    Range("CI3").Select
    ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,C44)"
    Range("CI2:CI3").Select
   
     
    Selection.Copy
   
    Range("AW2:CH3").Select
    ActiveSheet.Paste
    Range("AW2:CH3").Select
    Application.CutCopyMode = False
'
   
    Range("AQ4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
    Range("CI2:CI3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("AP4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("CH2:CH3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("AO4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
    Range("CG2:CG3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
5
    Range("AN4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
    Range("CF2:CF3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("AM4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
    Range("CE2:CE3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AL4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
    Range("CD2:CD3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("AK4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
    Range("CC2:CC3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("AJ4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
    Range("CB2:CB3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("AI4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
    Range("CA2:CA3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
  ...../......
   
   
   
   
    Range("W4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
    Range("BO2:BO3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("V4").Select
Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
    Range("BN2:BN3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("U4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
    Range("BM2:BM3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("T4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
   
   
    Range("BL2:BL3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("S4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("BK2:BK3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("R4").Select
   Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("BJ2:BJ3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("Q4").Select
   Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("BI2:BI3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("P4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("BH2:BH3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("O4").Select
   Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("BG2:BG3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("N4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
    Range("BF2:BF3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("M4").Select
   Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("BE2:BE3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("L4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("BD2:BD3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("K4").Select
  Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("BC2:BC3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("J4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("BB2:BB3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("I4").Select
   Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("BA2:BA3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("H4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("AZ2:AZ3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("G4").Select
    Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("AY2:AY3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("F4").Select
   Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
   
    Range("AX2:AX3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
    Range("E4").Select
   
  Set plage = Range("a4:ar1248")
    plage.AutoFilter Field:=ActiveCell.Column, Criteria1:=">-24", Operator:=xlAnd
    Range("AW2:AW3").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
End Sub
VBA

cordialement
pascal
 

Pièces jointes

  • test macro rotation nul.xlsm
    462.7 KB · Affichages: 27
Vote positif 0 Vote négatif

Discussions similaires

R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
261
robpellan52
R
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
328
gwenn49
G
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
440
olivier388
O
X
  • Question
XL 2016 Copier à partir de la dernière ligne renseignée.
Réponses
8
Affichages
408
Xender
X
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
366
fanou06
F
chilo27
  • Question
Autres Simplifier une macro
Réponses
1
Affichages
260
fanch55
fanch55
Usine à gaz
  • Résolu(e)
XL 2021 Coller "RdV Fait Facturé" de "J" ligne active jusqu'à "J" dernière ligne NON vide
2
Réponses
27
Affichages
591
TooFatBoy
TooFatBoy
B
  • Résolu(e)
XL 2016 macro avec boucle
2
Réponses
16
Affichages
1 K
benbella1991
B
mouchtre
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
519
mouchtre
mouchtre

Membres actuellement en ligne

Aucun membre en ligne actuellement.
1 membres et 46 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 165
Messages
2 085 880
Membres
103 009
dernier inscrit
dede972