XL 2019 problème lors de l'exécution du code vba

  • Initiateur de la discussion Initiateur de la discussion Dadi147
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Dadi147

XLDnaute Occasionnel
Bonjour, lors de l'exécution du code, il copie les nouvelles données sur les anciennes, je ne sais pas pourquoi ?


VB:
Private Sub CommandButton10_Click()
If Me.txt_product.Value = "" Then
   MsgBox "attention", vbCritical
   Exit Sub
   End If
If IsNumeric(Me.txt_price_pru) = False Then
   MsgBox "attention svp", vbCritical
   Exit Sub
   End If
   If IsNumeric(Me.txt_price_sale) = False Then
   MsgBox "attention svp", vbCritical
   Exit Sub
   End If
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("product_master")
If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.txt_product.Value) > 0 Then
 MsgBox "value déjà"""", vbCritical
 Exit Sub
End If
Dim lr As Integer
lr = appliction.worksheetfuncion.CountA(sh.Range("A:A"))
sh.Range("A" & lr + 1).Value = lr
sh.Range("B" & lr + 1).Value = Me.txt_product.Value
sh.Range("C" & lr + 1).Value = Me.txt_price_sale.Value
sh.Range("D" & lr + 1).Value = Me.txt_price_pru.Value

Me.txt_product.Value = ""
Me.txt_price_sale.Value = ""
Me.txt_price_pru.Value = ""
MsgBox "Done", vbtnformation
 
bonjour à tous,staple1600
je pense que cela vient du counta
teste ceci
VB:
Private Sub CommandButton10_Click()
    Dim lr As Integer
    If Me.txt_product.Value = "" Then Err.Raise vbObjectError + 1
    If IsNumeric(Me.txt_price_pru) = False Then Err.Raise vbObjectError + 2
    If IsNumeric(Me.txt_price_sale) = False Then Err.Raise vbObjectError + 2
    If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.txt_product.Value) > 0 Then Err.Raise vbObjectError + 3
    lr = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
    sh.Range("A" & lr).Value = lr
    sh.Range("B" & lr).Value = Me.txt_product.Value
    sh.Range("C" & lr).Value = Me.txt_price_sale.Value
    sh.Range("D" & lr).Value = Me.txt_price_pru.Value
    Me.txt_product.Value = ""
    Me.txt_price_sale.Value = ""
    Me.txt_price_pru.Value = ""
    MsgBox "Done", vbtnformation
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case vbObjectError + 1: MsgBox "attention ", vbCritical
        Case vbObjectError + 2: MsgBox "attention svp", vbCritical
        Case vbObjectError + 3: MsgBox "value déjà"""", vbCritical"
    End Select
End Sub
 
Bonjour @Dadi147 🙂, @Staple1600 😉, @jpb388 🙂,

Essayez ce code (non testé puisque pas de classeur joint 🙁 ):
Code:
   Dim lr As Long
   With sh
      If .FilterMode Then .ShowAllData           'pour que le END() fonctionne correctement!
      lr = .Cells(Rows.Count, "a").End(xlUp).Row + 1
      .Cells(lr, "a") = lr - 1
      .Cells(lr, "b") = Me.txt_product
      .Cells(lr, "c") = Me.txt_price_sale
      .Cells(lr, "d") = Me.txt_price_pru
   End With
 
Dernière édition:
Bonjour le fil

@mapomme
Je me permets (le temps que mon poisson finisse de cuire) 😉
Ou Essayez ce code (testé ,car j'ai aussi mes courgettes à cuire 😉)
VB:
Private Sub CommandButton1_Click()
Dim lr&
   With ActiveSheet
      If .FilterMode Then .ShowAllData           'pour que le END() fonctionne correctement!
      lr = .Cells(Rows.Count, 1).End(3).Row + 1
      Cells(lr, 1).Resize(, 4) = Array(lr - 1, txt_product, txt_price_sale, txt_price_pru)
   End With
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
126
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
76
Réponses
1
Affichages
320
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
247
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
498
Retour