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

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
260
robpellan52
R
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
2 K
fanou06
F
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
R
  • Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
1 K
TooFatBoy
TooFatBoy
O
  • Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
438
olivier388
O
H
  • Question
XL 2016 Mettre des titres avec une mise en forme spécifique
Réponses
1
Affichages
274
vgendron
vgendron
A
  • Résolu(e)
XL 2013 Code VBA incompatible avec version Excel
Réponses
2
Affichages
388
Averell1976
A
S
  • Résolu(e)
XL 2016 Besoin d'aide pour un code d'extraction
Réponses
14
Affichages
264
Phil69970
Phil69970
M
  • Question
XL 2013 Envoyer un mail automatique avec le contenu de la bonne ligne
Réponses
2
Affichages
638
Oneida
Oneida
M
  • Résolu(e)
XL 2016 Filtre auto VBA
Réponses
3
Affichages
569
MickaeL_D
M

Membres actuellement en ligne

9 membres et 84 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 111
Messages
2 085 395
Membres
102 882
dernier inscrit
Sultan94