Microsoft 365 Mise à jour cellules du stock

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: 21

rubis54

XLDnaute Occasionnel
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 ...
Regarde la pièce jointe 1116803
OK Jean Marie,
j'ai testé et cela à l'air de fonctionner. Si je choisis par exemple un article avec un stock zéro il ne l'affiche pas.
Super.
C'est vraiment sympa de votre part et de Fanch55 ainsi que Lolote83.
Pour nous c'est pas simple et parfois on pose trop de questions peut-être mais on est obligé, il faut bien que ça rentre🤣
A+
 

ChTi160

XLDnaute Barbatruc
Re
j'ai trouvé cette méthode !
On regarde la Hauteur du DataBodyRange si = à 0 c'est qu'il n'y a pas de ligne Visible !
VB:
If Worksheets("STOCK").ListObjects("Tableau2").DataBodyRange.Height = 0 Then Exit Sub

juste pour le Fun Lol
jean marie
 

fanch55

XLDnaute Accro
On regarde la Hauteur du DataBodyRange si = à 0 c'est qu'il n'y a pas de ligne Visible !
Super Jean-Marie, je n'y avions point pensé 😁
Je vais retenir la formule de contournement précieusement .

@rubis54 : code modifié :
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
        If [Tableau2[#data]].Height > 0 Then [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
        [Tableau2].ListObject.Range.AutoFilter
    End If
    
End Sub
 

rubis54

XLDnaute Occasionnel
Super Jean-Marie, je n'y avions point pensé 😁
Je vais retenir la formule de contournement précieusement .

@rubis54 : code modifié :
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
        If [Tableau2[#data]].Height > 0 Then [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
        [Tableau2].ListObject.Range.AutoFilter
    End If
   
End Sub
Re Fanch55,

j'ai aussi cette proposition pour le code en question.

"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
If [Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Rows.Count = 0 Then Exit Sub 'Ici
[Tableau2[Désignation]].SpecialCells(xlCellTypeVisible).Copy [D2]
[Tableau2].ListObject.Range.AutoFilter
End If
Sheets("STOCK").Range("A1:F1685").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("SORTIE DU JOUR").Range _
("B1:B2"), CopyToRange:=Sheets("SORTIE DU JOUR").Range("E1"), Unique:=False
End Sub"
 

Statistiques des forums

Discussions
294 039
Messages
1 935 783
Membres
187 447
dernier inscrit
Harvedo