Cellule ne conserve pas les données anciennes

Bonjour à tous, j'ai un problème avec la macro suivante.

Private Sub ValiderSaisie_Click()

ActiveWorkbook.Save

Dim débit As String, crédit As String

Dim tfeuilles As Variant, sname As String, ligne As Long, sname2 As String, ligne2 As Long, sname3 As String, ligne3 As Long, sname4 As String, ligne4 As Long, sname5 As String, ligne5 As Long

Dim sname6 As String, ligne6 As Long, sname7 As String, ligne7 As Long, sname8 As String, ligne8 As Long, sname9 As String, ligne9 As Long

tfeuilles = Array("Comptes de Capital", "Comptes d'Immobilisations", "Comptes de Stocks et En-Cours", "Comptes de Tiers", "Comptes Financiers", "Comptes de Charges", "Comptes de Produits", "Comptes Spéciaux")

sname = tfeuilles(-1 + Left(D1.Value, 1) * 1) 'racine de compte détermine l'item à renvoyer (! -1 car tfeuilles est en base 0 !)

With Sheets(sname) 'avec feuille obtenue
    ligne = Application.Match(D1.Value * 1, .Columns(1), 0) 'ligne = position corresp. D1.value dans colonne 1
    .Cells(ligne, 2) = Cells(ligne, 2) + MD1.Value 'sur cette ligne, en col2, valeur de MD1
End With

If D2.Value <> "" Then

sname2 = tfeuilles(-1 + Left(D2.Value, 1) * 1) 'racine de compte détermine l'item à renvoyer (! -1 car tfeuilles est en base 0 !)

With Sheets(sname2) 'avec feuille obtenue
    ligne2 = Application.Match(D2.Value * 1, .Columns(1), 0) 'ligne = position corresp. D2.value dans colonne 1
    .Cells(ligne2, 2) = Cells(ligne2, 2) + MD2.Value 'sur cette ligne, en col2, valeur de MD2
End With

End If

If D3.Value <> "" Then

sname3 = tfeuilles(-1 + Left(D3.Value, 1) * 1) 'racine de compte détermine l'item à renvoyer (! -1 car tfeuilles est en base 0 !)

With Sheets(sname3) 'avec feuille obtenue
    ligne3 = Application.Match(D3.Value * 1, .Columns(1), 0) 'ligne = position corresp. D3.value dans colonne 1
    .Cells(ligne3, 2) = Cells(ligne3, 2) + MD3.Value 'sur cette ligne, en col2, valeur de MD3
End With

End If

If D4.Value <> "" Then

sname4 = tfeuilles(-1 + Left(D4.Value, 1) * 1) 'racine de compte détermine l'item à renvoyer (! -1 car tfeuilles est en base 0 !)

With Sheets(sname4) 'avec feuille obtenue
    ligne4 = Application.Match(D4.Value * 1, .Columns(1), 0) 'ligne = position corresp. D4.value dans colonne 1
    .Cells(ligne4, 2) = Cells(ligne4, 2) + MD4.Value 'sur cette ligne, en col2, valeur de MD4
End With

End If

If D5.Value <> "" Then

sname5 = tfeuilles(-1 + Left(D5.Value, 1) * 1) 'racine de compte détermine l'item à renvoyer (! -1 car tfeuilles est en base 0 !)

With Sheets(sname5) 'avec feuille obtenue
    ligne5 = Application.Match(D5.Value * 1, .Columns(1), 0) 'ligne = position corresp. D5.value dans colonne 1
    .Cells(ligne5, 2) = Cells(ligne5, 2) + MD5.Value 'sur cette ligne, en col2, valeur de MD5
End With

End If

sname6 = tfeuilles(-1 + Left(C1.Value, 1) * 1) 'racine de compte détermine l'item à renvoyer (! -1 car tfeuilles est en base 0 !)

With Sheets(sname6) 'avec feuille obtenue
    ligne6 = Application.Match(C1.Value * 1, .Columns(1), 0) 'ligne = position corresp. C1.value dans colonne 1
    .Cells(ligne6, 3) = Cells(ligne6, 3) + MC1.Value 'sur cette ligne, en col3, valeur de MC1
End With

If C2.Value <> "" Then

sname7 = tfeuilles(-1 + Left(C2.Value, 1) * 1) 'racine de compte détermine l'item à renvoyer (! -1 car tfeuilles est en base 0 !)

With Sheets(sname7) 'avec feuille obtenue
    ligne7 = Application.Match(C2.Value * 1, .Columns(1), 0) 'ligne = position corresp. C2.value dans colonne 1
    .Cells(ligne7, 3) = Cells(ligne7, 3) + MC2.Value 'sur cette ligne, en col3, valeur de MC2
End With

End If

If C3.Value <> "" Then

sname8 = tfeuilles(-1 + Left(C3.Value, 1) * 1) 'racine de compte détermine l'item à renvoyer (! -1 car tfeuilles est en base 0 !)

With Sheets(sname8) 'avec feuille obtenue
    ligne8 = Application.Match(C3.Value * 1, .Columns(1), 0) 'ligne = position corresp. C3.value dans colonne 1
    .Cells(ligne8, 3) = Cells(ligne8, 3) + MC3.Value 'sur cette ligne, en col3, valeur de MC3
End With

End If

If C4.Value <> "" Then

sname9 = tfeuilles(-1 + Left(C4.Value, 1) * 1) 'racine de compte détermine l'item à renvoyer (! -1 car tfeuilles est en base 0 !)

With Sheets(sname9) 'avec feuille obtenue
    ligne9 = Application.Match(C4.Value * 1, .Columns(1), 0) 'ligne = position corresp. C4.value dans colonne 1
    .Cells(ligne9, 3) = Cells(ligne9, 3) + MC4.Value 'sur cette ligne, en col3, valeur de MC4
End With

End If

If C5.Value <> "" Then

sname10 = tfeuilles(-1 + Left(C5.Value, 1) * 1) 'racine de compte détermine l'item à renvoyer (! -1 car tfeuilles est en base 0 !)

With Sheets(sname10) 'avec feuille obtenue
    ligne10 = Application.Match(C5.Value * 1, .Columns(1), 0) 'ligne = position corresp. C5.value dans colonne 1
    .Cells(ligne10, 3) = Cells(ligne10, 3) + MC5.Value 'sur cette ligne, en col3, valeur de MC5
End With

End If

PanneauDeSaisie.Hide

D1 = ""
D2 = ""
D3 = ""
D4 = ""
D5 = ""
MD1 = ""
MD2 = ""
MD3 = ""
MD4 = ""
MD5 = ""
C1 = ""
C2 = ""
C3 = ""
C4 = ""
C5 = ""
MC1 = ""
MC2 = ""
MC3 = ""
MC4 = ""
MC5 = ""

End Sub

en effet lorsque je rentre une valeur dans une cells(ligne x,2) ou cells(ligne x, 3) qui était vide elle prend bien en compte la valeur, mais lorsque je le fais dans une cellule contenant déjà une donnée, elle remplace la donnée existante, pourquoi ?

merci d'avance

Bonjour,

Comme ça à vue d'œil, pas simple à dire, merci de joindre un fichier anonymisé

@+

8comptaauto.xlsm (120.83 Ko)

Merci beaucoup

Re,

Il faudrait nous indiquer les actions à effectuer pour reproduire le problème !?

Dans l'onglet accueil, quand je clique sur saisir une écriture, dans ma colonne la plus à gauche je saisis le N° de compte débit et à côté son montant, et dans la colonne de droites pareil mais au débit, et quand je saisis deux fois la même écriture ca ne sauvegarde que la deuxième.

Bonjour Luigi200145,

Je ne vois pas vraiment ce qui clochait à part peut-être le ".value" Essaye ceci (code optimisé)

Private Sub ValiderSaisie_Click()
  ActiveWorkbook.Save
  Dim Ind As Integer
  Dim CtlC As Control, CtlM As Control
  Dim débit As String, crédit As String
  Dim tfeuilles As Variant, sname As String, ligne As Long
  ' Tableau des feuilles
  tfeuilles = Array("Comptes de Capital", "Comptes d'Immobilisations", "Comptes de Stocks et En-Cours", "Comptes de Tiers", "Comptes Financiers", "Comptes de Charges", "Comptes de Produits", "Comptes Spéciaux")
  For Ind = 1 To 5
    ' Définir les controles DEBIT à traiter
    Set CtlC = Me.Controls("D" & Ind)
    Set CtlM = Me.Controls("MD" & Ind)
    ' Si le contrôle contient une valeur
    If CtlC.Value <> "" Then
      sname = tfeuilles(-1 + Left(CtlC.Value, 1) * 1) 'racine de compte détermine l'item à renvoyer (! -1 car tfeuilles est en base 0 !)
      With Sheets(sname) 'avec feuille obtenue
        ligne = Application.Match(CtlC.Value * 1, .Columns(1), 0) 'ligne = position corresp. dans colonne 1
        .Cells(ligne, 2).Value = .Cells(ligne, 2).Value + CtlM.Value 'sur cette ligne, en col2, valeur de montant
      End With
    End If
    ' Définir les controles CREDIT à traiter
    Set CtlC = Me.Controls("C" & Ind)
    Set CtlM = Me.Controls("MC" & Ind)
    If CtlC.Value <> "" Then
      sname = tfeuilles(-1 + Left(CtlC.Value, 1) * 1) 'racine de compte détermine l'item à renvoyer (! -1 car tfeuilles est en base 0 !)
      With Sheets(sname) 'avec feuille obtenue
        ligne = Application.Match(CtlC.Value * 1, .Columns(1), 0) 'ligne = position corresp. dans colonne 1
        .Cells(ligne, 3).Value = .Cells(ligne, 3).Value + Ctl.Value 'sur cette ligne, en col3, valeur de montant
      End With
    End If
  Next Ind
  PanneauDeSaisie.Hide
  ' Effacer les valeurs
  For Ind = 1 To 5
    Me.Controls("D" & Ind) = ""
    Me.Controls("MD" & Ind) = ""
    Me.Controls("C" & Ind) = ""
    Me.Controls("MC" & Ind) = ""
  Next Ind
End Sub

@+

Je vais essayer merci beaucoup

Bonjour à tous,

Sujet traité (et je l'espère résolu) en privé.

A priori le problème portait sur cette ligne (et les lignes sembables) :

.Cells(ligne, 2) = Cells(ligne, 2) + MD1.Value

où il manquait le point devant le second cells. L'userform étant sur une page d'accueil, on faisait la somme de MD1 et de 0...

Cdlt,

Bonjour le fil

@3GB, effectivement, même pas remarqué

@Luigi, faire des demande en MP ce n'est pas très fairplay, d'autant plus si la solution est trouvée et non signalée

Salut Bruno,

En fait, j'ai reçu le MP après la dernière réponse de Luigi et j'ai posté mon commentaire juste après avoir envoyé le fichier à Luigi donc ce n'était pas vraiment en parallèle...

A plus,

Rechercher des sujets similaires à "conserve pas donnees anciennes"