Remplir une ligne automatiquement a partir d'une autre cellule

Bonjour à tous, j'espère que vous êtes en forme

Je travaille sur un projet de logistique, et mon fichier permet le suivi de reception de colis. Je souhaiterais lorsque le Numéro Chrono (colonneA) est remplie, que la date s'affiche automatiquement en colonne B, la colonne C permet de reconnaitre le type de matériel (3 cas) selon le premier chiffre du numéro chrono.

J'ai trouvé un code permettant de réaliser cela, mais il n'est pas pratique car un double clique en colonne B, ou si on souhaite supprimer une ligne suffit à le faire bugger.

Je souhaite savoir si quelque chose de plus simple est faisable , il est important que la dernière cellule vide soit sélectionné, et que les doublons de numéros soient empêchés.

Voici mon bout de code

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A2: A5550")) Is Nothing Then

Target.Offset(0, 1) = Now()

Target.Offset(0, 2) = Left(Target.Offset(0, 0), 1)

Dim TYPEFLUX As String

TYPEFLUX = Left(Target.Offset(0, 0), 1)

If TYPEFLUX = 1 Then 'renvoie REC REP AREP selon le premier chiffre du code barre

Target.Offset(0, 2) = "REC"

End If

If TYPEFLUX = 2 Then

Target.Offset(0, 2) = "REP"

End If

If TYPEFLUX = 3 Then

Target.Offset(0, 2) = "AREP"

End If

End If

End Sub

Je vous remercie par avance

Comme d'habitude, un petit fichier explicatif

Julia^^

Bonjour,

J'ai pas mal modifié le fichier que tu as soumis pour aller au plus simple en utilisant un tableau (onglet Insérer > Tableau).

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Columns(1)) Is Nothing And Target.Count = 1 Then
        If Target.Value <> "" Then

            Dim TYPEFLUX$
            TYPEFLUX = Left(Target.Value, 1)

            'Doublons
            Dim cellule As Range
            For Each cellule In Range("Tableau1[NUMERO CHRONO]")
                If cellule.Value = Target.Value And cellule.Address <> Target.Address Then
                    MsgBox "La valeur est déjà présente en ligne " & cellule.Row & ".", vbCritical, "Avertissement"
                    Target.Interior.Color = 255
                    Exit Sub
                End If
            Next cellule

            'Renvoie REC REP AREP selon le premier chiffre du code barre
            Select Case TYPEFLUX
                Case 1
                    Target.Offset(0, 2) = "REC"
                Case 2
                    Target.Offset(0, 2) = "REP"
                Case 3
                    Target.Offset(0, 2) = "AREP"
                Case Else
                    MsgBox "Le code spécifié n'est pas valide", vbCritical, "Avertissement"
            End Select

            'Date
            Target.Offset(0, 1) = Now()

        End If
    End If

End Sub

Edit : Avec détection des doublons.

Honnêtement c'est parfait

Je n'avais pas pensé à la fonction tableau

Je peux que répondre bravo et merci

Ce forum est génial

Bonne journée

Julia^^