XL 2016 Mise à jour d'une base de données excel par VBA

G.BENOIT

XLDnaute Nouveau
Bonjour à tous,

J'ai besoin de votre aide pour un projet.

J'ai créé un formulaire qui remplit une base de donnée au fur à mesure des rentrées en fonction de certains critères :
Si cela concerne une ouverture de formation le chiffre "1" apparaît en fonction de la ligne de production.
Si cela concerne un validation de formation le chiffre "2" apparaît en fonction de la ligne de production.

Pas de soucis pour l'ouverture de formation (1), la création de la ligne se fait parfaitement.

La ou je bloque c'est que si je valide quelques jours plus tard une validation de formation (2) il me créer une deuxième ligne.

Ce que j'aimerais c'est que ma ligne d'avant s'actualise (en passant de la valeur "1" à la valeur "2") en fonction du "NOM" et "PRÉNOM" et de la ligne de production concernée en ne remplaçant que la valeur "1" concerné par la valeur "2".

Tout cela grâce à une macro.

Est ce possible ?

En vous remerciant d'avance.
 

Pièces jointes

  • FORMATION.xlsm
    41.2 KB · Affichages: 44

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour le fil, bonjour le forum,

J'ai eu beau lire et relire ton code je ne sais pas comment tu renvoies les données du "formulaire" dans la base. Quoi qu'il en soit il te faudra intégrer le code ci-dessous (en l'adaptant pour la variable CL (Colonne de la Ligne) :

VB:
Sub Macro1()
Dim OF As Worksheet
Dim OL As Worksheet
Dim TV As Variant
Dim I As Integer
Dim CL As Byte

Set OF = Worksheets("FORMATION PERMANENT")
Set OL = Worksheets("Liste")
TV = OL.Range("A1").CurrentRegion
Select Case OF.Range("D5").Value
    Case "Spin On avant", "Spin On arrière"
        CL = 5
    Case "Air Filter avant", "Air Filter arrière"
        CL = 6
    Case "Green cartridge", "eRCV", "Direct Flow"
        CL = 7
End Select
For I = 2 To UBound(TV, 1)
    If OF.Range("G11") = TV(I, 1) And OF.Range("G13") = TV(I, 2) And TV(I, CL) = 1 Then OL.Cells(I, CL).Value = 2: Exit Sub
Next I
End Sub
 

G.BENOIT

XLDnaute Nouveau
Bonjour désolé pour ma réponse tardive.

Tout d'abord merci pour votre aide, alors pour commencer ci-dessus le code qui me permet de renvoyer les données du "formulaire" dans une base de données située dans un autre fichier.

Le bouton "Ouverture formation" renvoie la valeur 1 et le bouton "Validation formation" renvoie la valeur 2.

Ce que j'aimerais c'est que mon code actualise la ligne en remplaçant un 1 par un 2 si je valide une formation ou alors rajouter un 1 sur une autre ligne de production sans effacer le reste.

En se basant sur le concatenate de la colonne A ou des colonnes B et C (Nom et prénom).

Recherche si non trouvé création d'un ligne si trouvé mise à jour des valeurs 1 et 2.

Merci Robert mais je galère un peu à comprendre la fin de ton code.

Capture01.PNG

VB:
        'Mise à jour de la base de donnée planning
        Dim LastRow As Long
        Dim WsDepart As Worksheet
        Dim WsDestination As Worksheet
        Workbooks.Open Filename:="N:\27 - Production - VSB\02 UAP\2019\Production UAP\Module\planning équipes SCANIA DAF EEA.xlsx"      'planning equipe
        Set WsDestination = Workbooks("planning équipes SCANIA DAF EEA").Worksheets("Feuil2") 'planning equipe
        Set WsDepart = Workbooks("Formulaire de saisie des formations").Worksheets("FORMATION INTERIMAIRE") 'formulaire formation
        LastRow = WsDestination.Range("B" & Rows.Count).End(xlUp).Row
        Application.ScreenUpdating = False
        WsDepart.Range("G9").Copy 'formulaire formation
        WsDestination.Range("B" & LastRow + 1).PasteSpecial xlPasteValues
        WsDepart.Range("G11").Copy 'formulaire formation
        WsDestination.Range("C" & LastRow + 1).PasteSpecial xlPasteValues
        WsDepart.Range("G5").Copy 'formulaire formation
        WsDestination.Range("D" & LastRow + 1).PasteSpecial xlPasteValues
        WsDepart.Range("E15").Copy 'formulaire formation
        WsDestination.Range("H" & LastRow + 1).PasteSpecial xlPasteValues
        WsDepart.Range("N14").Copy 'formulaire formation
        Select Case WsDepart.Range("D5").Value
        Case "lignes tête 1 & 2"
        WsDestination.Range("E" & LastRow + 1).PasteSpecial xlPasteValues
        Case "Modules SCANIA"
        WsDestination.Range("F" & LastRow + 1).PasteSpecial xlPasteValues
        Case "Modules DAF"
        WsDestination.Range("G" & LastRow + 1).PasteSpecial xlPasteValues
        End Select
        Workbooks("planning équipes SCANIA DAF EEA").Save
        Workbooks("planning équipes SCANIA DAF EEA").Close
        MsgBox "Mise à jour de la base de donnée, Ouverture du dossier de polyvalences intérimaires."
        Workbooks.Open ("N:\27 - Production - VSB\02 UAP\02 - Tableaux de polyvalence\Matrices de compétences toutes UAP\matrice competences interims.xlsm")
        Application.Wait (Now + TimeValue("00:00:03"))
        Set ws = ActiveWorkbook.Worksheets("Matrice competence interim")
        Set ws = Nothing
        End If
        End If
End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Re,

Désolé Benoit mais je ne sais pas travailler avec des codes incomplets. Il y a 2 End If dans le dernier code qui sortent de nulle part !?... Je te propose de fournir tous les fichiers nécessaires et le code complet...