Créer un registre de cave avec VBA/Macros
Bonjour j'ai créé un fichier excel avec deux feuilles :
1) Registre de cave actuel (ce qui reste dans la cave)
2) Registre de cave historique (ce qui a été consommé)
Le but est lorsque je séléctionne le "oui" dans la case "rupture de stock" de la feuille "registre de cave actuel", la ligne s'efface et apparaisse en haut du tableau "registre de cave historique" et que la case "date de consommation" soit la date du jour ou j'ai cliqué sur "rupture de stock".
J'ai presque réussi avec l'utilisation d'une macro, mon problême: Ce n'est pas la ligne ou je clique sur oui qui passe dans l'autre tableau, mais automatiquement la premiere ligne du tableau "registre de cave"...
Je vous mets mon tableau en pj
Un grand merci pour votre aide !!
Bonjour,
Voici le code a remplacer dans la feuille "Actuel" :
Ton "code" enregistreur de macro était verrouillé à uniquement la première ligne
Là, le code traitera toutes tes lignes (Supprime en 1er toutes tes lignes dans historique de la ligne 6 à 100.) pour faire le reser du copier/coller
Option Explicit
Public colonne, ligne As Integer
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then
Exit Sub
End If
'Fixation des limites
If Target.Row > 3 And Target.Column = 12 Then
ligne = Target.Row
colonne = Target.Column
If Target.Value = "Oui" Then
ActiveWorkbook.Sheets("Actuel").Activate
ActiveSheet.Rows(ligne).Copy
ActiveWorkbook.Sheets("Historique").Activate
ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count + 1, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Sheets("Actuel").Activate
ActiveSheet.Rows(ligne).Delete
ActiveWorkbook.Save
Else
'Non
End If
End If
End Sub
Bonjour,
Dans le même esprit avec affectation des valeurs :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Plage As Range
If Target.Column <> 12 Then Exit Sub
If Target.Row < 4 Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "Oui" Then
Set Plage = Range(Cells(Target.Row, 1), Cells(Target.Row, 10))
With Worksheets("Historique")
.Rows(4).EntireRow.Insert
.Rows(4).EntireRow.Interior.ColorIndex = 0
.Rows(4).EntireRow.Font.ColorIndex = 1
.Range(.Cells(4, 1), .Cells(4, 10)).Value = Plage.Value
.Cells(4, 11).Value = Format(Date, "dd-mmm-yy")
End With
End If
End Sub
Bonjour,
Dans le même esprit avec affectation des valeurs :
Private Sub Worksheet_Change(ByVal Target As Range) Dim Plage As Range If Target.Column <> 12 Then Exit Sub If Target.Row < 4 Then Exit Sub If Target.Count > 1 Then Exit Sub If Target.Value = "Oui" Then Set Plage = Range(Cells(Target.Row, 1), Cells(Target.Row, 10)) With Worksheets("Historique") .Rows(4).EntireRow.Insert .Rows(4).EntireRow.Interior.ColorIndex = 0 .Rows(4).EntireRow.Font.ColorIndex = 1 .Range(.Cells(4, 1), .Cells(4, 10)).Value = Plage.Value .Cells(4, 11).Value = Format(Date, "dd-mmm-yy") End With End If End Sub
@Theze,
Merci pour ton aide, ton code est parfait la seule manquante est que la ligne de feuille "Actuel" ne se supprime pas !
Oups, petit oubli !
Juste une ligne à rajouter :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Plage As Range
If Target.Column <> 12 Then Exit Sub
If Target.Row < 4 Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Value = "Oui" Then
Set Plage = Range(Cells(Target.Row, 1), Cells(Target.Row, 10))
With Worksheets("Historique")
.Rows(4).EntireRow.Insert
.Rows(4).EntireRow.Interior.ColorIndex = 0
.Rows(4).EntireRow.Font.ColorIndex = 1
.Range(.Cells(4, 1), .Cells(4, 10)).Value = Plage.Value
.Cells(4, 11).Value = Format(Date, "dd-mmm-yy")
End With
Target.EntireRow.Delete 'suppression de la ligne
End If
End Sub
Genial, merci beaucoup pour ton aide, la c'est tout simplement parfait ;
Content de t'avoir aidé