Modifier macro enregistrement

bonjour a tous

je joins mon fichier

La macro valider_nouvelle_donnée que j'utilise fonctionne très bien jusqu'à la cellule désignation

mais je voudrais allez jusqu'à la cellule commentaire pour enregistrer et la galère

si quelqu'un a une idée je suis preneur

merci par avance

aiglon74

Bonjour,

Un essai ...

Sub valider_nouvelle_donnée()
   'aiglon74

Dim nd(7), I%, fin&  ''' << Nd(7) au lieu de 4 pour ajouter les 3 nouveaux éléments
   With ActiveSheet
      For I = 0 To 7 ''' << 7 au lieu de 4 pour ajouter les 3 nouveaux éléments   
         nd(I) = .Cells(8, (I + 1) * 2).Value

         If nd(I) = "" And I < 7 Then ''' << 7 au lieu de 4 pour ajouter les 3 nouveaux éléments

            MsgBox .Cells(6, (I + 1) * 2).Value & " manquante.", vbInformation, "Erreur nouvelle donnée"
            Exit Sub
         End If
      Next I
   End With
   Dim trouve As Range
   If Application.CountIf(Worksheets("BASE").Columns("B"), nd(0)) > 0 Then      ' L'emplacemt existe dans la feuille "BASE"
      Set trouve = Feuil7.Range("b:b").Find("LIBRE", lookat:=xlWhole)
      If Not trouve Is Nothing Then
         If MsgBox("Cet emplacement existe déjà !" & Chr(10) & " l'emplacement " & trouve.Offset(0, -1) & _
                   " est disponible" & vbCr & vbCr & "Voulez vous garder l'emplacement " & UCase(nd(0)), _
                   vbCritical + vbYesNo, "Erreur d'emplacement") <> vbYes Then Exit Sub
      End If
   End If
   Application.ScreenUpdating = False
   With Worksheets("BASE")
      .Rows(7).Insert
      .Cells(8, 6).Copy
      .Cells(7, 6).PasteSpecial xlPasteFormulas
      For I = 0 To 3
         .Cells(7, I + 2).Value = nd(I)
      Next I
      .Cells(7, 7).Value = nd(4)
      .Cells(7, 8).Value = nd(5)     ''' << ajout de la colonne H
      .Cells(7, 11).Value = nd(6)    ''' << ajout de la colonne K
      .Cells(7, 12).Value = nd(7)    ''' << ajout de la colonne L
      With .Range("B7:L7")
         With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
         End With
         For I = 7 To 10
            With .Borders(I)
               .LineStyle = xlContinuous
               .Weight = xlMedium
            End With
         Next I
      End With
      fin = .Range("B" & .Rows.Count).End(xlUp).Row
      .Range("B7:L" & fin).Sort key1:=.Range("B7"), order1:=xlAscending, Header:=xlNo
      MsgBox ("ENREGISTREMENT REUSSI."), vbExclamation, "Enregistrement nouvelle donnée"

   End With
   Application.ScreenUpdating = True
   Worksheets("nouvelle ref").Range("B8,D8,F8,H8,J8,L8,N8,P8").ClearContents

   Application.ScreenUpdating = False
   Sheets("nouvelle ref").Select
   ActiveSheet.Unprotect
   Range("Q8").Select
   Selection.Locked = False
   Selection.FormulaHidden = False
   Sheets("nouvelle ref").Select
   Worksheets("nouvelle ref").Range("Q8").ClearContents
   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

   Sheets("nouvelle ref").Select
   ActiveSheet.Unprotect
   Selection.Locked = True
   Selection.FormulaHidden = False
   Sheets("nouvelle ref").Select
   ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   Range("B8").Select

End Sub

ric

Bonsoir ric

génial au top

si j'ose une explication en face des lignes possible

mais sincèrement merci

Bonjour,

Modifs sur seulement 3 lignes ...

Ajouts de 3 nouvelles lignes ...

Voir code précédent ...

ric

re

merci pour ta réponse

aiglon74