XL 2019 Organiser le code VBA

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
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
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
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
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
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
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

M
  • Résolu(e)
Microsoft 365 Pouvez-vous traduire le code VBA SVP ?
Réponses
8
Affichages
132
MOLY_
M
X
  • Question Question
XL 2021 Transformation de données sur une ligne en plusieurs lignes
Réponses
9
Affichages
164
xavieralvaro
X
ph.vanne
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
489
ph.vanne
ph.vanne
G
  • Question Question
XL 2019 Sélectionner un fichier pour mettre à jour une base de données
Réponses
3
Affichages
216
sylvanu
sylvanu
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
425
Phil69970
Phil69970
C
  • Question Question
Microsoft 365 Enregistrer via VBA sans ouvrir fichier
Réponses
9
Affichages
294
cdric78
C
M
  • Question Question
XL 2021 VBA Excel Erreur 2023
Réponses
2
Affichages
241
MICHIS
M
eastwick
  • Résolu(e)
XL 2016 macro fichier fermé
Réponses
1
Affichages
51
eastwick
eastwick
M
  • Question Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
17
Affichages
936
MICHAEL
M
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
574
robpellan52
R
C
  • Question Question
Microsoft 365 worksheet_change
2
Réponses
29
Affichages
258
CortoXls
C
B
  • Question Question
XL 2019 Dans une macro de démarrage de fichier masquer le code par des Astérix ou point
Réponses
3
Affichages
100
sylvanu
sylvanu
N
  • Question Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
427
Phil69970
Phil69970
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
2 K
job75
job75
thunder23
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
122
thunder23
thunder23
B
  • Question Question
XL 2016 VBA - Ajout de consignes dans le corps d'un mail
Réponses
3
Affichages
262
kiki29
kiki29
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
M
  • Question Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
417
marie3107
M
G
  • Résolu(e)
XL 2013 copier coller valeur d'une colonne dynamique
Réponses
13
Affichages
681
gwenn49
G
M
  • Question Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
415
Gégé-45550
Gégé-45550
Retour