Discussion :

[INFINITY100]

Bonjour a tous

Voila je suis face à un problème de fusion de 3 macros qui s’appliquent sur la même feuille, le souci c'est que j'arrive pas à les faire fusionner pour en faire qu'une seule

Voici donc mes macros

La première macro qui envoi les données inscrit dans le formulaire vers la feuille BD_Dettesrèglements:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub ValiderDettes_Click()
'Variables qui vont nous servir à alimenter la feuille BD_Dettesrèglements via les données saisies dans l'UserForm
  Dim Ctrl As Control
  Dim r As Integer
  Dim Derligne As Integer
  Dim LigneDebut As Long
 
With Worksheets("BD_DettesRéglements")
      LigneDebut = 12
      Derligne = .Range("C" & Cells.Rows.Count).End(xlUp).Row + 1
      If .Cells(Derligne - 1, 1).Value = "Total" Then Derligne = Derligne - 1
      For Each Ctrl In AjoutDettes.Controls
        r = Val(Ctrl.Tag)
          If r > 0 Then
              If Ctrl.Name = "Montant_TextBox" Then
                .Cells(Derligne, r) = Val(Ctrl)
                .Cells(Derligne, r).NumberFormat = "#,##0.00"
              Else
                .Cells(Derligne, r) = Ctrl
              End If
          End If
       Next
End Sub

La deuxième est pour l'incrémentation numérique qui commence de la ligne 12 colonne B dans la feuille BD_Dettesrèglements:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub ValiderDettes_Click()
 
  Dim DerniereLigne As Long
  Dim CtrI As Long
 
With Worksheets("BD_DettesRéglements")
         LigneDebut = 12
         DerniereLigne = .Cells(.Rows.Count, 3).End(xlUp).Row
         For CtrI = LigneDebut To DerniereLigne
             If .Cells(CtrI, 3) <> "" Then
                .Cells(CtrI, 2) = WorksheetFunction.CountA(Range(.Cells(LigneDebut, 12), .Cells(CtrI, 7)))
             Else
                .Cells(CtrI, 2) = ""
             End If
        Next CtrI
   End With
End Sub

La troisième est pour tri par ordre alphabétique avec étendu dans la feuille BD_Dettesrèglements:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Sheets("BD_DettesRéglements").Select
Range("B12:G" & Derligne).Sort Key1:=Range("C12"), Order1:=xlAscending, Header:=xlYes

Merci à vous tous

Cordialement

[Gado2600]

Juste comme ça : où est la complexité que tu vois dedans ?

Tu as 3 bouts de codes avec maximum 15 lignes, qui ont le même procédé mais des calculs différents et même sans ce détail, je ne comprend absolument pas où est le problème ?

Je pense même que tu as perdu plus de temps à poster ta demande que de lire ton code et de voir ce que tu pouvais faire...

[INFINITY100]

Salut l'ami

oui tu avais entièrement raison c’était tellement claire que je me suis compliqué la vie moi même hhh

donc voila au final j'ai réussi à résoudre le problème et voici ce que ça donne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Private Sub ValiderDettes_Click()
  Dim DerniereLigne As Long
  Dim Derligne As Integer
  Dim LigneDebut As Long
  Dim Ctrl As Control
  Dim CtrI As Long
  Dim r As Integer
 
   With Worksheets("BD_DettesRéglements")
      LigneDebut = 12
      Derligne = .Range("C" & Cells.Rows.Count).End(xlUp).Row + 1
      For Each Ctrl In AjoutDettes.Controls
        r = Val(Ctrl.Tag)
          If r > 0 Then
              If Ctrl.Name = "Montant_TextBox" Then
                .Cells(Derligne, r) = Val(Ctrl)
                .Cells(Derligne, r).NumberFormat = "#,##0.00"
              Else
                .Cells(Derligne, r) = Ctrl
              End If
          End If
       Next
'Tri par ordre alphabétique
    Sheets("BD_DettesRéglements").Select
    Range("B12:G" & Derligne).Sort Key1:=Range("C12"), Order1:=xlAscending, Header:=xlYes
'Avec la feuille consernée l'incrémentation numérique commence de la ligne 12 colonne B
      DerniereLigne = .Cells(.Rows.Count, 3).End(xlUp).Row
      For CtrI = LigneDebut To DerniereLigne
          If .Cells(CtrI, 3) <> "" Then
             .Cells(CtrI, 2) = WorksheetFunction.CountA(Range(.Cells(LigneDebut, 12), .Cells(CtrI, 7)))
          Else
             .Cells(CtrI, 2) = ""
          End If
      Next CtrI
'Le message
     If MsgBox("La dette attribuée à (" & ComboBox1 & ") a été ajoutée avec succès voulez-vous enregistrer une autre dette ?", vbYesNo, "Confirmation") = vbYes Then
        Montant_TextBox = ""
        Me.ComboBox1.Clear
        Me.ComboBox1.SetFocus
        Else
        Unload AjoutDettes
     End If
     End With
End Sub

Merci encore

Cordialement