Microsoft 365 Mise à jour cellules du stock

R

rubis54

XLDnaute Occasionnel
Bonjour tout le monde,

Après multiples changements de mon classeur Stock, je pense avoir trouvé quelque chose de plus simple mais trop difficile pour moi en ce qui concerne le VBA pour faire fonctionner cela.

Explications:

A part la feuille "TDB" et "STOCK" il y a 3 feuilles supplémentaires "SORTIE DU JOUR, COMMANDE et ENTREE STOCK"

- sur ces trois feuilles, on se place sur B2 pour taper les premières lettres de l'article recherché et on presse la touche Entrée. Ensuite il affiche en colonne "D" les articles trouvés. On choisit ensuite l'article voulu, on double clique sur l'article et il vient s'afficher dans le tableau à droite(pareil pour les trois feuilles) il ne reste plus qu'a remplir les cellules de la colonne Qté.

Jusqu'ici tout va bien. Lorsque je clique sur "RAZ et Mise à jour stock", il mets à jour uniquement les deux premières lignes de mon stock. Donc même si je choisis un seul article par exemple " tomates " pour la sortie du jour , pour la commande ou pour entrée stock, il mettra à jour la première ligne de mon stock au lieu de mettre à jour la ligne des tomates dans le stock.

Alors est ce quelqu'un pourrai m'aider à rectifier ces erreurs SVP.

Je vous Remercie d'avance.

Rubis54
 

Pièces jointes

  • gestion-stock.xlsm
    234.6 KB · Affichages: 37
Trier par date Trier par votes
R

rubis54

XLDnaute Occasionnel
fanch55 à dit:
Je n'ai rien fourni pour la feuille stock .

Le worksheet_change au post 4 concerne uniquement la feuille "sortie du jour".
Cliquez pour agrandir...
Bonjour Fanch55,

je suis vraiment désolé de vous embêter à ce point, mais j'ai du mal à comprendre .

Le code ci-dessous je l'ai placé dans la feuille "STOCK"
"Private Sub Worksheet_Activate()
If [Tableau2].ListObject.AutoFilter Is Nothing Then
[Tableau2].AutoFilter
End If
End Sub"
Est ce correct ?

Ensuite le code ci-dessous je l'ai placé dans la feuille "SORTIE DU JOUR"
Private Sub Worksheet_Change(ByVal Target As Range)

" If Target.Address = [B2].Address Then
Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
[Tableau2].ListObject.Range.AutoFilter
[Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
[Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
[Tableau2].ListObject.Range.AutoFilter
End If

End Sub"

Est ce correct?

Mais si je veux éxecuter ce code il m'ouvre la fenêtre des macros !

Voici tout ce qui a dans la feuille "SORTIE DU JOUR"

Private Sub Worksheet_Change(ByVal Target As Range)

' Macro1 Macro
'

'
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Sheets("STOCK").Range("B1:B1685").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("SORTIE DU JOUR").Range _
("B1:B2"), CopyToRange:=Range("D1"), Unique:=False

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim derniereligne As Integer

'affiche le numéro de la dernière ligne de la colonne F
derniereligne = Range("F" & Rows.Count).End(xlUp).Row

' Ne fonctionne que si les produits sont triés en colonne B
If Target.Count = 1 Then
If Not Intersect(Target, [D1:D1685]) Is Nothing Then

'trouver, en colonne B, la position de la 1re occurence du produit
ligneDépart = Application.Match(Target, [D1:D1685], 0)

'trouve la dernière ligne de la colonne F et décale cette ligne vers le bas grace au +1
Range("F" & derniereligne + 1).Value = Target

End If
End If
Cancel = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = [B2].Address Then
Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
[Tableau2].ListObject.Range.AutoFilter
[Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
[Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
[Tableau2].ListObject.Range.AutoFilter
End If

End Sub

Merci à vous pour votre réponse.
Cdt Rubis54
 
Vote positif 0 Vote négatif
ChTi160

ChTi160

XLDnaute Barbatruc
Bonjour rubis54
Bonjour le Fil,le forum

Pas sûr d'avoir compris lol
Mais dans les éléments d'une feuille tu ne peux avoir qu'une seule procédure événementielle de chaque type.
Exemple une seule
Private Sub Worksheet_Change(ByVal Target As Range)
Cliquez pour agrandir...
Il faut alors regrouper ce que tu veux faire lors de cet événement dans une seule procédure,ou de supprimer ce qui ne sert pas
Jean marie
 
Vote positif 0 Vote négatif
R

rubis54

XLDnaute Occasionnel
ChTi160 à dit:
Bonjour rubis54
Bonjour le Fil,le forum

Pas sûr d'avoir compris lol
Mais dans les éléments d'une feuille tu ne peux avoir qu'une seule procédure événementielle de chaque type.
Exemple une seule

Il faut alors regrouper ce que tu veux faire lors de cet événement dans une seule procédure,ou de supprimer ce qui ne sert pas
Jean marie
Cliquez pour agrandir...
Bonjour ChTi160,
Merci pour ton info.
Alors comment je fais ? je supprime la procédure ci dessous, je vais la placer ou pour que le reste fonctionne ?
Merci d'avance pour ton aide
Cdt Rubis54

"Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim derniereligne As Integer

'affiche le numéro de la dernière ligne de la colonne F
derniereligne = Range("F" & Rows.Count).End(xlUp).Row

' Ne fonctionne que si les produits sont triés en colonne B
If Target.Count = 1 Then
If Not Intersect(Target, [D1:D1685]) Is Nothing Then

'trouver, en colonne B, la position de la 1re occurence du produit
ligneDépart = Application.Match(Target, [D1:D1685], 0)

'trouve la dernière ligne de la colonne F et décale cette ligne vers le bas grace au +1
Range("F" & derniereligne + 1).Value = Target

End If
End If
Cancel = True
End Sub"
 
Vote positif 0 Vote négatif
R

rubis54

XLDnaute Occasionnel
fanch55 à dit:
Bonjour à tous,
Tu remplaces toute ta partie

par la mienne ( ou tu mets la tienne en commentaire )
Cliquez pour agrandir...
Bonjour Fanch55

Donc j'ai fais comme ca ci-dessous

Private Sub Worksheet_Change(ByVal Target As Range)

' Macro1 Macro
'

'
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
Sheets("STOCK").Range("B1:B1685").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("SORTIE DU JOUR").Range _
("B1:B2"), CopyToRange:=Range("D1"), Unique:=False




Dim derniereligne As Integer

'affiche le numéro de la dernière ligne de la colonne F
derniereligne = Range("F" & Rows.Count).End(xlUp).Row

' Ne fonctionne que si les produits sont triés en colonne B
If Target.Count = 1 Then
If Not Intersect(Target, [D1:D1685]) Is Nothing Then

'trouver, en colonne B, la position de la 1re occurence du produit
ligneDépart = Application.Match(Target, [D1:D1685], 0)

'trouve la dernière ligne de la colonne F et décale cette ligne vers le bas grace au +1
Range("F" & derniereligne + 1).Value = Target

End If
End If
Cancel = True


If Target.Address = [B2].Address Then
Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
[Tableau2].ListObject.Range.AutoFilter
[Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
[Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
[Tableau2].ListObject.Range.AutoFilter
End If

End Sub

Mais si j'éxecute il m'ouvre la fenêtre des macros !!!
 
Vote positif 0 Vote négatif
R

rubis54

XLDnaute Occasionnel
ChTi160 à dit:
J'aurais pas dit mieux lol

Si tu en a besoin et qu'elle n'est pas en double tu la laisses
Supprime juste le double du

Jean marie
Cliquez pour agrandir...
Re Jean-Marie,

alors j'ai placé le tout comme ci-dessous dans la feuille"SORTIE DU JOUR", mais il m'affiche toujours encore les articles qui n'ont pas de quantité stock, donc 0.


Private Sub Worksheet_Change(ByVal Target As Range)

' Macro1 Macro

Sheets("STOCK").Range("B1:B1685").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("SORTIE DU JOUR").Range _
("B1:B2"), CopyToRange:=Range("D1"), Unique:=False

If Target.Address = [B2].Address Then
Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
[Tableau2].ListObject.Range.AutoFilter
[Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
[Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
[Tableau2].ListObject.Range.AutoFilter
End If

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim derniereligne As Integer

'affiche le numéro de la dernière ligne de la colonne F
derniereligne = Range("F" & Rows.Count).End(xlUp).Row

' Ne fonctionne que si les produits sont triés en colonne B
If Target.Count = 1 Then
If Not Intersect(Target, [D1:D1685]) Is Nothing Then

'trouver, en colonne B, la position de la 1re occurence du produit
ligneDépart = Application.Match(Target, [D1:D1685], 0)

'trouve la dernière ligne de la colonne F et décale cette ligne vers le bas grace au +1
Range("F" & derniereligne + 1).Value = Target

End If
End If
Cancel = True
End Sub
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
Tu vas remplacer tout le code de la feuille "Sortie du Jour" par celui-ci :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Address = [B2].Address Then
        Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
        [Tableau2].ListObject.Range.AutoFilter
        [Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
        [Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
        [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
        [Tableau2].ListObject.Range.AutoFilter
    End If
    
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Ligne As Integer:
    
    If Target.Count = 1 Then
        Ligne = Range("D" & Rows.Count).End(xlUp).Row
        If Not Intersect(Target, Range("D1:D" & Ligne)) Is Nothing Then
            Ligne = Range("F" & Rows.Count).End(xlUp).Row
            Range("F" & Ligne + 1).Value = Target
            Range("G" & Ligne + 1).Activate
        End If
    End If
    Cancel = True
    
End Sub

Et n'essayes pas de les exécuter, ce sont des macros événementielles :
La première s'active dès que tu changes quoi que ce soit sur la feuille
La seconde s'active quand tu fait un double-clic sur la feuille
 
Vote positif 0 Vote négatif
R

rubis54

XLDnaute Occasionnel
fanch55 à dit:
Tu vas remplacer tout le code de la feuille "Sortie du Jour" par celui-ci :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Target.Address = [B2].Address Then
        Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
        [Tableau2].ListObject.Range.AutoFilter
        [Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
        [Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
        [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
        [Tableau2].ListObject.Range.AutoFilter
    End If
   
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim Ligne As Integer:
   
    If Target.Count = 1 Then
        Ligne = Range("D" & Rows.Count).End(xlUp).Row
        If Not Intersect(Target, Range("D1:D" & Ligne)) Is Nothing Then
            Ligne = Range("F" & Rows.Count).End(xlUp).Row
            Range("F" & Ligne + 1).Value = Target
            Range("G" & Ligne + 1).Activate
        End If
    End If
    Cancel = True
   
End Sub

Et n'essayes pas de les exécuter, ce sont des macros événementielles :
La première s'active dès que tu changes quoi que ce soit sur la feuille
La seconde s'active quand tu fait un double-clic sur la feuille
Cliquez pour agrandir...
Re Fanch55,

Alors si je tombe sur un article lequel a un stock nul, il m'affiche l'image ci-dessous.
Peut-on pas faire en sorte que si on tombe sur un stock zéro qu'il m'affiche un MsgBox par exemple ?
 

Pièces jointes

  • stock nul.JPG
    stock nul.JPG
    115.1 KB · Affichages: 26
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
Oki,
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Address = [B2].Address Then
        Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
        [Tableau2].ListObject.Range.AutoFilter
        [Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
        [Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
        On Error Resume Next
        [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
        [Tableau2].ListObject.Range.AutoFilter
    End If
    
End Sub
 
Vote positif 0 Vote négatif
R

rubis54

XLDnaute Occasionnel
fanch55 à dit:
Oki,
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
   
    If Target.Address = [B2].Address Then
        Range("D2:D" & WorksheetFunction.Max(2, Cells(Rows.Count, "D").End(xlUp).Row)).Clear
        [Tableau2].ListObject.Range.AutoFilter
        [Tableau2].ListObject.Range.AutoFilter Field:=2, Criteria1:="=" & [B2] & "*", Operator:=xlAnd
        [Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
        On Error Resume Next
        [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
        [Tableau2].ListObject.Range.AutoFilter
    End If
   
End Sub
Cliquez pour agrandir...
ça fonctionne Fanch55, Merci encore pour ton aide. Je vais mettre tout à jour et je reviendrai sur le forum car j'aimerai bien ajouter deux trois choses si possible.
A+
Cdt Rubis54
 
Vote positif 0 Vote négatif
R

rubis54

XLDnaute Occasionnel
ChTi160 à dit:
Bonjour rubis54
Bonjour le Fil,le forum

Pas sûr d'avoir compris lol
Mais dans les éléments d'une feuille tu ne peux avoir qu'une seule procédure événementielle de chaque type.
Exemple une seule

Il faut alors regrouper ce que tu veux faire lors de cet événement dans une seule procédure,ou de supprimer ce qui ne sert pas
Jean marie
Cliquez pour agrandir...
Re Jean Marie,

je ne vois plus ton dernier message, tu veux bien me le renvoyer STP

Merci
Cdt Rubis54
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
ChTi160 à dit:
Re
je ne suis pas un expert , mais on peut aussi tester s'il y a une Ligne Visible dans le DataBodyrange du Tableau ! plutôt qu'un "On error resume Next" Non ?
VB: 
[Tableau2].ListObject.Range.AutoFilter Field:=5, Criteria1:=">0", Operator:=xlAnd
If [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Rows.Count = 0 Then Exit Sub 'Ici
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
jean marie
Cliquez pour agrandir...
Salut Jean-Marie,
On se demande parfois si les différents dév d'Office ont un cahier de charge "abouti" avec des spécifs similaires.
Malheureusement,
dès qu'on fait appel à la propriété spécialcells,
on n'aura jamais count=0
car une erreur est tout de suite produite en ce cas .
Ce n'est pas propre indéniablement mais il faut vivre avec ...
1632917898542.png
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2016 Colorer en vert le besoin effectif par rapport au stock
Réponses
2
Affichages
139
job75
job75
H
  • Question
XL 2010 du Stock
Réponses
3
Affichages
790
hema300
H
N
  • Question
Microsoft 365 Suivi production et gestions des stocks matière première et produits finis
Réponses
2
Affichages
342
nathalieg13
N
A
  • Résolu(e)
XL 2016 Passer d'une MFC à une macro pour supprimer le bazar dans les règles.
2 3
Réponses
38
Affichages
916
Dudu2
Dudu2
H
  • Question
XL 2010 quantite-transferee de stock
Réponses
1
Affichages
465
hema300
H
L
  • Résolu(e)
XL 2021 Aide VBA pour appli Gestion de stock
Réponses
2
Affichages
281
LuckyShuri
L
gael56000
  • Question
Microsoft 365 Gestion de Stock
Réponses
2
Affichages
2 K
gael56000
gael56000
Jsquare
  • Résolu(e)
XL 2013 Gestion de stock sous excel
2
Réponses
18
Affichages
1 K
Jsquare
Jsquare
M
  • Résolu(e)
Microsoft 365 Code pour mise a jour
2
Réponses
26
Affichages
1 K
Marvin57
M
M
  • Question
XL 2010 Aide à la suppression d'un produit en double dans un magasin spécifique avec conditions
Réponses
9
Affichages
694
Mody200
M

Membres actuellement en ligne

21 membres et 277 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
314 750
Messages
2 112 475
Membres
111 561
dernier inscrit
PIERRE006