XL 2019 Organiser le code VBA

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
 

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
 

Kevin38

XLDnaute Nouveau
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
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
 

Kevin38

XLDnaute Nouveau
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" ?
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

@+
 

Kevin38

XLDnaute Nouveau
Salut, vu ton niveau médiocre tous les conseils sont bons à prendre pour la suite.
@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.
 

Discussions similaires

Réponses
3
Affichages
672

Statistiques des forums

Discussions
313 205
Messages
2 096 209
Membres
106 531
dernier inscrit
ahmedahmed