Ajout de ligne vide tableau
Bonjour Trucky93
Mise à part le fait que je ne comprends pas pourquoi vous n'utilisez pas de TCD pour obtenir vos résultats
Vous pouvez n'utiliser qu'une seule et unique macro pour la mise à jour de votre compta et non une par adhérent
De plus l'ajout de ligne était mal placé
Sub MAJcpta()
Dim i%, j%, cpt%, tb1 As ListObject, tb2 As ListObject
Application.ScreenUpdating = False
Set ws1 = Sheets("Tresorerie")
Set tb1 = ws1.ListObjects("Treso")
' Utiliser le nom en C2 comme nom de feuille
Set ws2 = ActiveSheet
Set tb2 = ws2.ListObjects(1)
'tb2.Range(2, 1).Select: GoTo fin
'tableau adherent vide
If (tb2.ListRows.Count = 0 Or tb2.ListRows.Count = 1) And tb2.Range(2, 1).Value = "" Then
x = 2
For i = 1 To tb1.ListRows.Count
'si adherent ok
If tb1.DataBodyRange(i, 2).Value = ws2.Range("C2").Value Then
tb2.Range(x, 1).Value = CDate(tb1.DataBodyRange(i, 1).Value) 'date paiement
tb2.Range(x, 2).Value = tb1.DataBodyRange(i, 2).Value 'nom adherent
If tb1.DataBodyRange(i, 3).Value <> "" Then tb2.Range(x, 3).Value = tb1.DataBodyRange(i, 3).Value 'debit
If tb1.DataBodyRange(i, 4).Value <> "" Then tb2.Range(x, 4).Value = tb1.DataBodyRange(i, 4).Value 'credit
x = x + 1
cpt = 1
End If
Next i
Else
'tableau adherent non vide
For i = 1 To tb1.ListRows.Count
'si date treso > derniere date compta adh et adherent ok
If DateDiff("d", CDate(tb2.DataBodyRange(tb2.ListRows.Count, 1).Value), CDate(tb1.DataBodyRange(i, 1).Value)) > 0 And _
tb1.DataBodyRange(i, 2).Value = ws2.Range("C2").Value Then
' Ajouter la ligne ICI
Set lig = tb2.ListRows.Add 'ajout ligne à la fin du TS
x = lig.Index + 1 'indice ligne ajoutée
' On continue
tb2.Range(x, 1).Value = CDate(tb1.DataBodyRange(i, 1).Value) 'date paiement
tb2.Range(x, 2).Value = tb1.DataBodyRange(i, 2).Value 'nom adherent
'MsgBox "ok": GoTo fin
If tb1.DataBodyRange(i, 3).Value <> "" Then
tb2.Range(x, 3).Value = tb1.DataBodyRange(i, 3).Value 'debit
End If
If tb1.DataBodyRange(i, 4).Value <> "" Then
tb2.Range(x, 4).Value = tb1.DataBodyRange(i, 4).Value 'credit
End If
cpt = 1
End If
Next i
End If
'annonce
If cpt > 0 Then MsgBox "Mise à jour du compte de " & ws2.Range("C2").Value & " effectuée."
fin:
Application.ScreenUpdating = True
End SubA+
Bonjour JExcel2fr,
Super çà fonctionne avec ce placement là.
Chaque page est réservée à l'adhérent, et il ne faut pas qu'il voit les opérations pour un autre adhérent.
Merci
Re,
Chaque page est réservée à l'adhérent, et il ne faut pas qu'il voit les opérations pour un autre adhérent.
Oui et alors, il n'y aura aucun problème avec 1 seul code
Ensuite, j'espère que vos adhérents ne sont pas des connaisseurs d'Excel, sinon trop facile
