Microsoft 365 Fichier de stock automatisé

  • Initiateur de la discussion Initiateur de la discussion Tomasisco21
  • Date de début Date de début
Tomasisco21

Tomasisco21

XLDnaute Nouveau
Bonjour à tous,

SVP j'aimerais savoir s'il est possible sur Excel, d'automatiser mon suivi de stock comme suit :

- Pour l'onglet "entrées" : toutes les saisies d'entrées doivent se mettre automatiquement sur l'onglet "suivi des stocks" conformément au modéle présenté.
- Pour l'onglet "sorties" : toutes les saisies de sorties doivent également se mettre de manière automatique sur l'onglet "suivi des stocks.
Par ailleurs, pour les sorties uniquement, le PU doit résulter automatiquement du PU moyen provenant de l'onglet "suivi des stocks".
- Pour l'onglet "suivi des stocks" aucune saisie à faire excepté une liste déroulante à insérer pour la partie "code et nature CAE".

D'avance merci pour votre aide, j'espère vraiment être un peu plus explicite dans ma demande.
 

Pièces jointes

Solution
AtTheOne
Bonsoir à toutes & à tous, bonsoir @Ndenga Thomas
Je te joint un exemple de ce que j'ai pu faire.
  • Légère modification sur la macro de suppression de la dernière ligne :
    Si le tableau ne contient plus de ligne, le bouton affiche "Tableau vide !" et la macro ne s'exécute pas
    Enrichi (BBcode): 
    Sub Suppression()Dim txt$, shp As Shape
     On Error Resume Next
     txt = Application.Caller
     On Error GoTo 0
     If txt = "" Then Exit Sub
     Set shp = ActiveSheet.Shapes(txt)
     If shp.DrawingObject.Caption = "Supprimer dernière ligne" Then
          With ActiveSheet.ListObjects(1)
               .ListRows(.ListRows.Count).Delete
          End With
     Else
          MsgBox "Le tableau est déjà vidé !"
     End...
Trier par date Trier par votes
AtTheOne

AtTheOne

XLDnaute Accro
Supporter XLD
Bonsoir à toutes & à tous, bonsoir @Ndenga Thomas
Je te joint un exemple de ce que j'ai pu faire.
  • Légère modification sur la macro de suppression de la dernière ligne :
    Si le tableau ne contient plus de ligne, le bouton affiche "Tableau vide !" et la macro ne s'exécute pas
    Enrichi (BBcode): 
    Sub Suppression()Dim txt$, shp As Shape
     On Error Resume Next
     txt = Application.Caller
     On Error GoTo 0
     If txt = "" Then Exit Sub
     Set shp = ActiveSheet.Shapes(txt)
     If shp.DrawingObject.Caption = "Supprimer dernière ligne" Then
          With ActiveSheet.ListObjects(1)
               .ListRows(.ListRows.Count).Delete
          End With
     Else
          MsgBox "Le tableau est déjà vidé !"
     End If
End Sub

  • Macros appelées lors de l'activation de la feuille "Suivi des stocks" :
    Insère les lignes existant dans l'une des feuilles "Entrée", "Sortie" qui ne se retrouvent pas dans "Suivi des stocks"
    Enrichi (BBcode): 
    Sub Insérer_Nouveau(FS$)
     Dim Wsh_S As Worksheet, Wsh_C As Worksheet
     Dim Lo_S As ListObject, Lo_C As ListObject, tS, tC, Clef
     Dim i As Integer, ligne As Integer, j As Byte
     Dim Dc_Mvt As New Scripting.Dictionary
     Dim Dc_Stock As New Scripting.Dictionary
     Dc_Mvt.CompareMode = TextCompare
     Dc_Stock.CompareMode = TextCompare
     Dim tb1(1 To 1, 1 To 3), tb2(1 To 1, 1 To 3)
   
     Set Wsh_S = ThisWorkbook.Worksheets(FS)
     Set Wsh_C = ThisWorkbook.Worksheets("Suivi des stocks")
     Select Case FS
          Case "Entrée"
               tS = Wsh_S.[t_Entree]
          Case "Sortie"
               tS = Wsh_S.[t_Sortie]
          Case Else
               Exit Sub
     End Select
     For i = 1 To UBound(tS)
          Dc_Mvt(tS(i, 2)) = i
     Next i
     tC = Wsh_C.[t_Stock]
     For i = 1 To UBound(tC)
          Dc_Stock(tC(i, 2)) = i
     Next i
   
     On Error Resume Next
     Dc_Mvt.Remove ("")
     Dc_Stock.Remove ("")
     On Error GoTo 0
   
     If Dc_Mvt.Count = 0 Then Exit Sub
   
     Set Lo_S = Wsh_S.ListObjects(1)
     Set Lo_C = Wsh_C.ListObjects(1)
     Clef = Dc_Mvt.Keys
     For i = 1 To Dc_Mvt.Count
          If Not Dc_Stock.Exists(Clef(i - 1)) Then
               ligne = Dc_Mvt(Clef(i - 1))
               For j = 1 To 3
                    tb1(1, j) = tS(ligne, j)
               Next j
               tb2(1, 1) = tS(ligne, 9)
               tb2(1, 2) = tS(ligne, 10)
               tb2(1, 3) = FS
               With Lo_C
                    .ListRows.Add
                    .ListRows(.ListRows.Count).Range.Cells(1).Resize(1, 3).Value = tb1
                    .ListRows(.ListRows.Count).Range.Cells(10).Resize(1, 3).Value = tb2
               End With
          End If
     Next i
   
End Sub

    Evénement activate de la feuille "Suivi des stocks" :
    Appelle la macro précédante, et trie le tableau dans l'ordre chronologique
    Code: 
    Private Sub Worksheet_Activate()
     Application.ScreenUpdating = False
     Insérer_Nouveau "Entrée"
     Insérer_Nouveau "Sortie"
     With Me.ListObjects("t_Stock").Sort
          .SortFields.Clear
          .SortFields.Add Key:=Range("t_Stock[Date]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
          .SortFields.Add Key:=Range("t_Stock[N° Bon]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
          .Header = xlYes
          .MatchCase = False
          .Orientation = xlTopToBottom
          .Apply
     End With
     Application.ScreenUpdating = True
End Sub

  • Macro exécutée lors d'une modification de la feuille "Entrée"
    Enrichi (BBcode): 
    Private Sub Worksheet_Change(ByVal Target As Range)     If Intersect(Target, Me.[t_Entree]) Is Nothing Then Exit Sub
   
     Dim Dc As New Scripting.Dictionary
     Dim tS, tC, WshC As Worksheet, r As Range, t
     Dim tb1(1 To 1, 1 To 3), tb2(1 To 1, 1 To 3)
     Dim i%, ligne%
     Set WshC = Worksheets("Suivi des stocks")
     tS = Me.[t_Entree]
     tC = WshC.[t_Stock]
     For i = 1 To UBound(tC)
          Dc(tC(i, 2)) = i
     Next
     For Each r In Target.Rows
          t = Intersect(Me.[t_Entree], r.EntireRow)
          If Not IsEmpty(t(1, 2)) Then
               For i = 1 To 3
                    tb1(1, i) = t(1, i)
               Next i
               tb2(1, 1) = t(1, 9)
               tb2(1, 2) = t(1, 10)
               tb2(1, 3) = Me.Name
               If Dc.Exists(t(1, 2)) Then
                    ligne = Dc(t(1, 2))
               Else
                    With WshC.ListObjects("t_Stock")
                         .ListRows.Add
                         ligne = .ListRows.Count
                    End With
               End If
               With WshC.[t_Stock]
                    .Cells(ligne, 1).Resize(1, 3) = tb1
                    .Cells(ligne, 10).Resize(1, 3) = tb2
               End With
                   
             
          End If
     Next
End Sub

  • Macro exécutée lors d'une modification de la feuille "Sortie"
    Enrichi (BBcode): 
    Private Sub Worksheet_Change(ByVal Target As Range)
     If Intersect(Target, Me.[t_Sortie]) Is Nothing Then Exit Sub
   
     Dim Dc As New Scripting.Dictionary
     Dim tS, tC, WshC As Worksheet, r As Range, t
     Dim tb1(1 To 1, 1 To 3), tb2(1 To 1, 1 To 3)
     Dim i%, ligne%
     Set WshC = Worksheets("Suivi des stocks")
     tS = Me.[t_Sortie]
     tC = WshC.[t_Stock]
     For i = 1 To UBound(tC)
          Dc(tC(i, 2)) = i
     Next
     For Each r In Target.Rows
          t = Intersect(Me.[t_Sortie], r.EntireRow)
          If Not IsEmpty(t(1, 2)) Then
               For i = 1 To 3
                    tb1(1, i) = t(1, i)
               Next i
               tb2(1, 1) = t(1, 9)
               tb2(1, 2) = t(1, 10)
               tb2(1, 3) = Me.Name
               If Dc.Exists(t(1, 2)) Then
                    ligne = Dc(t(1, 2))
               Else
                    With WshC.ListObjects("t_Stock")
                         .ListRows.Add
                         ligne = .ListRows.Count
                    End With
               End If
               With WshC.[t_Stock]
                    .Cells(ligne, 1).Resize(1, 3) = tb1
                    .Cells(ligne, 10).Resize(1, 3) = tb2
               End With
                   
             
          End If
     Next
End Sub
En cas de modification sur l'une des deux feuilles "Entrée", "Sortie", la feuille "Suivi des stocks" est mise à jour immédiatement. Sauf en cas de suppression d'une ligne. Il peut y avoir des bugs si l'on change le N° de bon car c'est sur cette information que j'identifie les lignes impactées.
J'ai laissé telles quelles tes formules car je ne suis pas sûr des régles que tu appliques.
Voilà, bon courage

Amicalement
Alain
Tiens moi informé
Amicalement
Alain
 

Pièces jointes

Vote positif 1 Vote négatif
Solution
Tomasisco21

Tomasisco21

XLDnaute Nouveau
AtTheOne à dit:
Bonsoir à toutes & à tous, bonsoir @Ndenga Thomas
Je te joint un exemple de ce que j'ai pu faire.
  • Légère modification sur la macro de suppression de la dernière ligne :
    Si le tableau ne contient plus de ligne, le bouton affiche "Tableau vide !" et la macro ne s'exécute pas
    Enrichi (BBcode): 
    Sub Suppression()Dim txt$, shp As Shape
     On Error Resume Next
     txt = Application.Caller
     On Error GoTo 0
     If txt = "" Then Exit Sub
     Set shp = ActiveSheet.Shapes(txt)
     If shp.DrawingObject.Caption = "Supprimer dernière ligne" Then
          With ActiveSheet.ListObjects(1)
               .ListRows(.ListRows.Count).Delete
          End With
     Else
          MsgBox "Le tableau est déjà vidé !"
     End If
End Sub

  • Macros appelées lors de l'activation de la feuille "Suivi des stocks" :
    Insère les lignes existant dans l'une des feuilles "Entrée", "Sortie" qui ne se retrouvent pas dans "Suivi des stocks"
    Enrichi (BBcode): 
    Sub Insérer_Nouveau(FS$)
     Dim Wsh_S As Worksheet, Wsh_C As Worksheet
     Dim Lo_S As ListObject, Lo_C As ListObject, tS, tC, Clef
     Dim i As Integer, ligne As Integer, j As Byte
     Dim Dc_Mvt As New Scripting.Dictionary
     Dim Dc_Stock As New Scripting.Dictionary
     Dc_Mvt.CompareMode = TextCompare
     Dc_Stock.CompareMode = TextCompare
     Dim tb1(1 To 1, 1 To 3), tb2(1 To 1, 1 To 3)
  
     Set Wsh_S = ThisWorkbook.Worksheets(FS)
     Set Wsh_C = ThisWorkbook.Worksheets("Suivi des stocks")
     Select Case FS
          Case "Entrée"
               tS = Wsh_S.[t_Entree]
          Case "Sortie"
               tS = Wsh_S.[t_Sortie]
          Case Else
               Exit Sub
     End Select
     For i = 1 To UBound(tS)
          Dc_Mvt(tS(i, 2)) = i
     Next i
     tC = Wsh_C.[t_Stock]
     For i = 1 To UBound(tC)
          Dc_Stock(tC(i, 2)) = i
     Next i
  
     On Error Resume Next
     Dc_Mvt.Remove ("")
     Dc_Stock.Remove ("")
     On Error GoTo 0
  
     If Dc_Mvt.Count = 0 Then Exit Sub
  
     Set Lo_S = Wsh_S.ListObjects(1)
     Set Lo_C = Wsh_C.ListObjects(1)
     Clef = Dc_Mvt.Keys
     For i = 1 To Dc_Mvt.Count
          If Not Dc_Stock.Exists(Clef(i - 1)) Then
               ligne = Dc_Mvt(Clef(i - 1))
               For j = 1 To 3
                    tb1(1, j) = tS(ligne, j)
               Next j
               tb2(1, 1) = tS(ligne, 9)
               tb2(1, 2) = tS(ligne, 10)
               tb2(1, 3) = FS
               With Lo_C
                    .ListRows.Add
                    .ListRows(.ListRows.Count).Range.Cells(1).Resize(1, 3).Value = tb1
                    .ListRows(.ListRows.Count).Range.Cells(10).Resize(1, 3).Value = tb2
               End With
          End If
     Next i
  
End Sub

    Evénement activate de la feuille "Suivi des stocks" :
    Appelle la macro précédante, et trie le tableau dans l'ordre chronologique
    Code: 
    Private Sub Worksheet_Activate()
     Application.ScreenUpdating = False
     Insérer_Nouveau "Entrée"
     Insérer_Nouveau "Sortie"
     With Me.ListObjects("t_Stock").Sort
          .SortFields.Clear
          .SortFields.Add Key:=Range("t_Stock[Date]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
          .SortFields.Add Key:=Range("t_Stock[N° Bon]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
          .Header = xlYes
          .MatchCase = False
          .Orientation = xlTopToBottom
          .Apply
     End With
     Application.ScreenUpdating = True
End Sub

  • Macro exécutée lors d'une modification de la feuille "Entrée"
    Enrichi (BBcode): 
    Private Sub Worksheet_Change(ByVal Target As Range)     If Intersect(Target, Me.[t_Entree]) Is Nothing Then Exit Sub
  
     Dim Dc As New Scripting.Dictionary
     Dim tS, tC, WshC As Worksheet, r As Range, t
     Dim tb1(1 To 1, 1 To 3), tb2(1 To 1, 1 To 3)
     Dim i%, ligne%
     Set WshC = Worksheets("Suivi des stocks")
     tS = Me.[t_Entree]
     tC = WshC.[t_Stock]
     For i = 1 To UBound(tC)
          Dc(tC(i, 2)) = i
     Next
     For Each r In Target.Rows
          t = Intersect(Me.[t_Entree], r.EntireRow)
          If Not IsEmpty(t(1, 2)) Then
               For i = 1 To 3
                    tb1(1, i) = t(1, i)
               Next i
               tb2(1, 1) = t(1, 9)
               tb2(1, 2) = t(1, 10)
               tb2(1, 3) = Me.Name
               If Dc.Exists(t(1, 2)) Then
                    ligne = Dc(t(1, 2))
               Else
                    With WshC.ListObjects("t_Stock")
                         .ListRows.Add
                         ligne = .ListRows.Count
                    End With
               End If
               With WshC.[t_Stock]
                    .Cells(ligne, 1).Resize(1, 3) = tb1
                    .Cells(ligne, 10).Resize(1, 3) = tb2
               End With
                  
            
          End If
     Next
End Sub

  • Macro exécutée lors d'une modification de la feuille "Sortie"
    Enrichi (BBcode): 
    Private Sub Worksheet_Change(ByVal Target As Range)
     If Intersect(Target, Me.[t_Sortie]) Is Nothing Then Exit Sub
  
     Dim Dc As New Scripting.Dictionary
     Dim tS, tC, WshC As Worksheet, r As Range, t
     Dim tb1(1 To 1, 1 To 3), tb2(1 To 1, 1 To 3)
     Dim i%, ligne%
     Set WshC = Worksheets("Suivi des stocks")
     tS = Me.[t_Sortie]
     tC = WshC.[t_Stock]
     For i = 1 To UBound(tC)
          Dc(tC(i, 2)) = i
     Next
     For Each r In Target.Rows
          t = Intersect(Me.[t_Sortie], r.EntireRow)
          If Not IsEmpty(t(1, 2)) Then
               For i = 1 To 3
                    tb1(1, i) = t(1, i)
               Next i
               tb2(1, 1) = t(1, 9)
               tb2(1, 2) = t(1, 10)
               tb2(1, 3) = Me.Name
               If Dc.Exists(t(1, 2)) Then
                    ligne = Dc(t(1, 2))
               Else
                    With WshC.ListObjects("t_Stock")
                         .ListRows.Add
                         ligne = .ListRows.Count
                    End With
               End If
               With WshC.[t_Stock]
                    .Cells(ligne, 1).Resize(1, 3) = tb1
                    .Cells(ligne, 10).Resize(1, 3) = tb2
               End With
                  
            
          End If
     Next
End Sub
En cas de modification sur l'une des deux feuilles "Entrée", "Sortie", la feuille "Suivi des stocks" est mise à jour immédiatement. Sauf en cas de suppression d'une ligne. Il peut y avoir des bugs si l'on change le N° de bon car c'est sur cette information que j'identifie les lignes impactées.
J'ai laissé telles quelles tes formules car je ne suis pas sûr des régles que tu appliques.
Voilà, bon courage

Amicalement
Alain
Tiens moi informé
Amicalement
Alain
Cliquez pour agrandir...
Bjr M. Alain,

Enorme 🙏👏 et GRAND MERCI : le problème est résolu. T'es un bon, les codes VBA fonctionnent correctement
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question Question
Access Gestion de stock
Réponses
0
Affichages
1 K
Schwalby
S
P
  • Question Question
Microsoft 365 gestion de stock avec plusieurs date de production sur même produit
Réponses
12
Affichages
2 K
pouetpouetlagalette
P
Tomasisco21
  • Question Question
Microsoft 365 Fichier automatisé VBA - Template Budget project
Réponses
5
Affichages
821
Tomasisco21
Tomasisco21
S
  • Question Question
XL pour MAC Tableau de gestion de production et de stock
Réponses
14
Affichages
2 K
ScamPs
S
Tomasisco21
  • Résolu(e)
Microsoft 365 Code VBA pour rechercher la valeur d'un produit sur 02 tables matrices (ou 02 onglets)
Réponses
8
Affichages
900
goube
goube
N
  • Résolu(e)
XL 2016 tableau de vente/gestion des stocks boutique : quelles formules ?!
2
Réponses
17
Affichages
2 K
Noëllie
N
M
  • Question Question
Microsoft 365 Gestion de stock pharmacie (entrée, sortie, graphiques)
4 5 6
Réponses
79
Affichages
15 K
Ghinzho
G
L
  • Question Question
XL 2016 Gestion de stock excel
Réponses
6
Affichages
3 K
Lily37
L
A
  • Question Question
Microsoft 365 Fichier de statistique et roulement
Réponses
0
Affichages
450
Aurel’Byylieve
A
M
  • Question Question
Microsoft 365 Gestion d'une refacturation en fonction d'un inventaire
Réponses
1
Affichages
535
MUGMRG
M
D
  • Résolu(e)
XL 2019 Gestion de stock produits frais
Réponses
6
Affichages
1 K
Dadoo80
D
T
  • Question Question
Microsoft 365 Planning de réservation de matériel (avec gestion des stocks) - Formules utiles ?
Réponses
7
Affichages
2 K
vgendron
vgendron
Vincent_2311
  • Question Question
XL 2019 [RESOLU] Gestion des flux de stocks en fonction des dates d'entrées et de sorties de stocks
Réponses
1
Affichages
2 K
Vincent_2311
Vincent_2311
F
  • Question Question
XL 2016 tableau gestion de stock
Réponses
9
Affichages
7 K
svmoss
S
A
  • Question Question
XL 2019 ajout automatique de quantités de sortie de stock au méme produit existant deja au tableau
Réponses
3
Affichages
934
vgendron
vgendron
C
  • Résolu(e)
Microsoft 365 Transposition de données automatiquement selon critères, c'est possible ?
Réponses
14
Affichages
1 K
job75
job75
T
  • Question Question
XL 2010 Aide fichier suivi palettes
Réponses
2
Affichages
3 K
ThomasGLT
T
T
  • Question Question
Microsoft 365 Création d'un fichier de reliquats
Réponses
1
Affichages
1 K
JHA
J
pompaero
  • Question Question
Microsoft 365 Recherche derniere date et calcul le nb de fois vu
Réponses
2
Affichages
666
pompaero
pompaero
M
  • Question Question
XL 2019 Gestion de stock - gérer les kit d'articles
Réponses
2
Affichages
2 K
Midolieu
M

Membres actuellement en ligne

16 membres et 258 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
315 297
Messages
2 118 164
Membres
113 442
dernier inscrit
Nancy3608