XL 2019 Organiser le code VBA

K

Kevin38

XLDnaute Nouveau
Bonjour à tous,

J'ai un classeur de gestion de stock, mais j'ai une macro assez longue, s'il y a quelqu'un qui pourrais m'aider à reformuler ce code mais plus court possible.
A la line Li 117, Col 35 dans ma feuille j'ai une formule (=150+N("10/05/2021")+0+N("10/06/2021")+0+N("10/07/2021")) qui permet d'ajouter le produit avec des dates (date change selon l'arrivage) à chaque arrivage, peut-on l'inclure dans le code.

S'il y a quelqu'un avec une solution pour y remédier ?

Merci d'avance

@+


VB: 
Sub Produit_Stocks()

    Range("C6").Select
    Selection.Copy
    Sheets("PRODUIT").Select
    Range("A2:C2").Select
    Application.CutCopyMode = False
    Selection.ListObject.ListRows.Add (1)
    Range("A2").Select
    Sheets("F PRODUIT").Select
    Range("C6").Select
    Selection.Copy
    Sheets("PRODUIT").Select
    Range("A2").Select
    ActiveSheet.Paste
    Range("A3").Select
    Sheets("F PRODUIT").Select
    Range("C9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PRODUIT").Select
    Range("B2").Select
    ActiveSheet.Paste
    
    Sheets("F PRODUIT").Range("C18").Copy
    Sheets("PRODUIT").Range("E2").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Range("A2:E2").Select
    
    Sheets("F PRODUIT").Select
    Range("C15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PRODUIT").Select
    Range("D2").Select
    ActiveSheet.Paste
    Range("A2:E2").Select
    Application.CutCopyMode = False
    
    Sheets("F PRODUIT").Select
    Range("C12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PRODUIT").Select
    Range("C2").Select
    ActiveSheet.Paste
    Range("A2:E2").Select
    Application.CutCopyMode = False
        
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
  
    Range("C2").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A2").Select
    Sheets("F PRODUIT").Select
    Range("C6").Select
    Selection.Copy
    Sheets("Gestion Stock").Select
    Range("A2").Select
    Application.CutCopyMode = False
    Selection.ListObject.ListRows.Add (1)
    Range("A2").Select
    Sheets("F PRODUIT").Select
    Range("C6").Select
    Selection.Copy
    Sheets("Gestion Stock").Select
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    Range("B2").Select
    Sheets("F PRODUIT").Select
    Range("C9").Select
    Selection.Copy
    Sheets("Gestion Stock").Select
    Range("B2").Select
    ActiveSheet.Paste
    Selection.Font.Bold = True
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "150"
    Range("A2:E2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("B5").Select
    Sheets("F PRODUIT").Select
    Range("C6,C9,C15,C12").Select
    Selection.ClearContents
    Range("C15").Activate
    Selection.ClearContents
    Range("C6").Select
End Sub
 
Trier par date Trier par votes
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Kevin,
Sans fichier test, difficile d'optimiser, en particulier vos mises en forme qu'on doit pouvoir simplifier suivant ce que vous voulez faire. ( d'ailleurs des commentaires dans le code aideraient ;) )
Il y a deux choses que vous pouvez peut être simplifier :
VB: 
Sheets("F PRODUIT").Select
Range("C6").Select
Selection.Copy
Sheets("PRODUIT").Select
Range("A2").Select
ActiveSheet.Paste
' Si uniquement valeur, peut être remplacé par :
Sheets("F PRODUIT").Range("C6").Copy Destination:=Sheets("PRODUIT").Range("A2")


Sheets("F PRODUIT").Select
Range("C6,C9,C15,C12").Select
Selection.ClearContents
' Peut être remplacé par :
Sheets("F PRODUIT").Range("C6,C9,C12,C15").ClearContents
 
Vote positif 1 Vote négatif
K

Kevin38

XLDnaute Nouveau
sylvanu à dit:
Bonsoir Kevin,
Sans fichier test, difficile d'optimiser, en particulier vos mises en forme qu'on doit pouvoir simplifier suivant ce que vous voulez faire. ( d'ailleurs des commentaires dans le code aideraient ;) )
Il y a deux choses que vous pouvez peut être simplifier :
VB: 
Sheets("F PRODUIT").Select
Range("C6").Select
Selection.Copy
Sheets("PRODUIT").Select
Range("A2").Select
ActiveSheet.Paste
' Si uniquement valeur, peut être remplacé par :
Sheets("F PRODUIT").Range("C6").Copy Destination:=Sheets("PRODUIT").Range("A2")


Sheets("F PRODUIT").Select
Range("C6,C9,C15,C12").Select
Selection.ClearContents
' Peut être remplacé par :
Sheets("F PRODUIT").Range("C6,C9,C12,C15").ClearContents
Cliquez pour agrandir...
Bonsoir Sylanu,

Merci pour votre réponse est-ce qu'on pas allez plus loin et avez vous une idée pour la ligne117 comme demandé précédemment.;)

@+

VB: 
Sub Produit_Stocks()

    Range("C6").Select
    Selection.Copy
    Sheets("PRODUIT").Select
    Range("A2:C2").Select
    Application.CutCopyMode = False
    Selection.ListObject.ListRows.Add (1)
    Range("A2").Select
    Sheets("F PRODUIT").Range("C6").Copy Destination:=Sheets("PRODUIT").Range("A2")
    Range("A3").Select
    Sheets("F PRODUIT").Select
    Range("C9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PRODUIT").Select
    Range("B2").Select
    ActiveSheet.Paste
    
    Sheets("F PRODUIT").Range("C18").Copy
    Sheets("PRODUIT").Range("E2").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Range("A2:E2").Select
    
    Sheets("F PRODUIT").Select
    Range("C15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PRODUIT").Select
    Range("D2").Select
    ActiveSheet.Paste
    Range("A2:E2").Select
    Application.CutCopyMode = False
    
    Sheets("F PRODUIT").Select
    Range("C12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("PRODUIT").Select
    Range("C2").Select
    ActiveSheet.Paste
    Range("A2:E2").Select
    Application.CutCopyMode = False
        
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
 
    Range("C2").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A2").Select
    Sheets("F PRODUIT").Select
    Range("C6").Select
    Selection.Copy
    Sheets("Gestion Stock").Select
    Range("A2").Select
    Application.CutCopyMode = False
    Selection.ListObject.ListRows.Add (1)
    Range("A2").Select
    Sheets("F PRODUIT").Select
    Range("C6").Select
    Selection.Copy
    Sheets("Gestion Stock").Select
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    Range("B2").Select
    Sheets("F PRODUIT").Select
    Range("C9").Select
    Selection.Copy
    Sheets("Gestion Stock").Select
    Range("B2").Select
    ActiveSheet.Paste
    Selection.Font.Bold = True
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "150"
    Range("A2:E2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("B5").Select
    Sheets("F PRODUIT").Range("C6,C9,C12,C15").ClearContents
    Range("C6").Activate
End Sub
 
Vote positif 0 Vote négatif
K

Kevin38

XLDnaute Nouveau
sylvanu à dit:
Re, bonsoir Kiki,
Concernant votre formule je ne vois pas ce qu'elle peut donner.
Qu'est censé retourner :
VB: 
=150+N("10/05/2021")+0+N("10/06/2021")+0+N("10/07/2021")
?
A quoi servent ces "0" ?
Cliquez pour agrandir...
Bonsoir,

Les 0 c'est la valeur ( nombre article) à ajouter et la date des date c'est aussi fictives

VB: 
=[B]150[/B]+N("10/05/2021")+0+N("jj/mm/aaaa")+0+N("jj/mm/aaaa")


Merci

@+
 
Vote positif 0 Vote négatif
K

Kevin38

XLDnaute Nouveau
kiki29 à dit:
Salut, vu ton niveau médiocre tous les conseils sont bons à prendre pour la suite.
Cliquez pour agrandir...
@kiki29 : apprendre, comprendre et évoluer n'as pas de niveau. Il y a quelques mois je n'utilisai même pas excel connaissais pas le VBA aujourd'hui je démarre. Apprendre n'a pas d'âge ;) et demander le savoir et le partager je trouve ça merveilleux. Dont je remercie encore le forum.
 
Vote positif 0 Vote négatif

Discussions similaires

ph.vanne
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
426
ph.vanne
ph.vanne
G
  • Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
173
sylvanu
sylvanu
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
324
Phil69970
Phil69970
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
528
robpellan52
R
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
1 K
job75
job75
N
  • Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
307
Phil69970
Phil69970
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
3 K
fanou06
F
B
  • Question
XL 2016 VBA - Ajout de consignes dans le corps d'un mail
Réponses
3
Affichages
199
kiki29
kiki29
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
AtTheOne

Membres actuellement en ligne

4 membres et 60 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
315 097
Messages
2 116 185
Membres
112 679
dernier inscrit
Yupanki