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 !!

579cave.xlsm (26.14 Ko)

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é

Rechercher des sujets similaires à "creer registre cave vba macros"