Reporter la valeur d'une textbox dans deux tableaux differents

bonjour je voudrais savoir s'il est possible de valider des valeurs de textbox dans plusieurs tableaux.

j'ai un bouton de commande qui me valide ces donnees dans un tableau

Private Sub BtnValider_Click()

Sheets("Feuil1").Select
Dim derligne As Integer
If MsgBox("Confirmez-vous cet ajout", vbYesNo, "Confirmation") = vbYes Then
derligne = Sheets("Feuil1").Range("A456541").End(xlUp).Row + 1

' ajout des données concernant le vin

Cells(derligne, 2) = CbbRegion.Value
Cells(derligne, 1) = CbbAppellation.Value & " " & CbbClassement.Value & " " & CbbMillesime & " " & CbbClimat.Value
Cells(derligne, 8) = TxtPrixU.Value
Cells(derligne, 3) = CbbClassement.Value
Cells(derligne, 4) = CbbMillesime.Value
Cells(derligne, 5) = CbbCouleur.Value
Cells(derligne, 6) = CbbQuantite.Value
Cells(derligne, 25) = CbbQuantite.Value

Cells(derligne, 7) = CbbEmplacement.Value & "." & CbbNiveau.Value
Cells(derligne, 9) = TxtApogee.Value

Cells(derligne, 11) = CbbDomaine.Value
Cells(derligne, 12) = TxtAdresse.Value
Cells(derligne, 13) = TxtCp.Value
Cells(derligne, 14) = TxtPortable.Value
Cells(derligne, 15) = TxtTel.Value
Cells(derligne, 16) = TxtMail.Value
Cells(derligne, 17) = TxtInternet.Value
Cells(derligne, 18) = TxtNom.Value
Cells(derligne, 24) = TxtCepage.Value
End If

end sub

je voudrais ensuite ajouter certaines données dans une autre feuille que j'ai appelée Historique achat qui ne reprends que l'appellation, le nom du domaine , la couleur

Merci pour votre aide

Bonjour,

Si tu as fait ce grand bout de code > le dernier petit bout allait de soi ...

Il restera à personnaliser les colonnes de destination dans la feuille "Historique Achat" ...

Private Sub BtnValider_Click()
Dim derligne As Integer

   If MsgBox("Confirmez-vous cet ajout", vbYesNo, "Confirmation") = vbYes Then

      With Worksheets("Feuil1")
         derligne = Sheets("Feuil1").Range("A456541").End(xlUp).Row + 1

         ' ajout des données concernant le vin
         .Cells(derligne, 2) = CbbRegion.Value
         .Cells(derligne, 1) = CbbAppellation.Value & " " & CbbClassement.Value & " " & CbbMillesime & " " & CbbClimat.Value
         .Cells(derligne, 8) = TxtPrixU.Value
         .Cells(derligne, 3) = CbbClassement.Value
         .Cells(derligne, 4) = CbbMillesime.Value
         .Cells(derligne, 5) = CbbCouleur.Value
         .Cells(derligne, 6) = CbbQuantite.Value
         .Cells(derligne, 25) = CbbQuantite.Value

         .Cells(derligne, 7) = CbbEmplacement.Value & "." & CbbNiveau.Value
         .Cells(derligne, 9) = TxtApogee.Value

         .Cells(derligne, 11) = CbbDomaine.Value
         .Cells(derligne, 12) = TxtAdresse.Value
         .Cells(derligne, 13) = TxtCp.Value
         .Cells(derligne, 14) = TxtPortable.Value
         .Cells(derligne, 15) = TxtTel.Value
         .Cells(derligne, 16) = TxtMail.Value
         .Cells(derligne, 17) = TxtInternet.Value
         .Cells(derligne, 18) = TxtNom.Value
         .Cells(derligne, 24) = TxtCepage.Value
      End With

      With Worksheets("Historique achat")
         derligne = .Range("A456541").End(xlUp).Row + 1
         .Cells(derligne, 1) = CbbAppellation.Value & " " & CbbClassement.Value & " " & CbbMillesime & " " & CbbClimat.Value
         .Cells(derligne, 3) = CbbDomaine.Value
         .Cells(derligne, 7) = CbbCouleur.Value
         .Cells(derligne, 2) = TxtDateSaisie.Value
         .Cells(derligne, 4) = TxtCp.Value
         .Cells(derligne, 5) = CbbQuantite.Value
         .Cells(derligne, 6) = TxtPrixU.Value
      End With

      ' classement par annee du plus ancien au plus recent

      Sheets("Feuil1").Activate
      Range("Tableau2").Select
      ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau2").Sort.SortFields. _
            Clear
      ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau2").Sort.SortFields. _
            Add2 Key:=Range("Tableau2[Millesime]"), SortOn:=xlSortOnValues, Order:= _
                 xlAscending, DataOption:=xlSortNormal
      With ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau2").Sort
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
      End With
      Range("A10").Select
      If MsgBox("Pensez à confirmer egalement l'historique d'achat", vbYesNo, "Confirmation") = vbYes Then
      End If
   End If
End Sub

ric

Bonsoir,

quel est donc ce chiffre exotique : 456541 ?
Vous pouvez avantageusement le remplacer par :
derligne = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row + 1

@ bientôt

LouReeD

merci à vous deux pour vos réponses

cordialement

Bonjour,

Désolé pour la coquille dans le code ...

J'ai corrigé le code de mon post précédent ...

ric