Discussion :

[Glorian]

Bonjour,

Je viens à vous parce que je me trouve dans une jolie impasse.
C'est un budget (de plus en plus étoffé) et il passe des valeurs d'un tableau à un autre.

Puisqu'il devient de plus en plus complexe de naviguer au travers des tableaux de chaque feuille, j'aimerais les scinder en plusieurs tableaux.

Plus clairement, par exemple, au lieu de passer des valeurs du compte chèque à "Visa Desjardins" dans la même feuille "Janvier", je voudrais créer un nouveau classeur appelé Visa.xlsx.
Ensuite, je passerais les valeurs, encore en exemple, la feuille "Janvier" du tableau "Compte chèque" (classeur Comptes.xlsm) vers la feuille "Janvier" du tableau "Visa Desjardins" du classeur Visa.xlsx.

Mais, je n'arrive pas à passer les valeurs d'un classeur à un autre.

Le VBA est le suivant

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim chqLR As Long, savLR As Long, celLR As Long, visLR As Long, MCrdLR As Long
       

If Target.Row < 6 Or Target.Row > 102 Then Exit Sub
If Target.Column <> 5 And Target.Column <> 9 And Target.Column <> 19 And Target.Column <> 23 And Target.Column <> 33 And Target.Column <> 37 And Target.Column <> 47 And Target.Column <> 51 And Target.Column <> 61 And Target.Column <> 66 And Target.Column <> 67 And Target.Column <> 69 Then Exit Sub

Application.EnableEvents = False

chqLR = Range("C" & 102).End(xlUp).Row
savLR = Range("Q" & 102).End(xlUp).Row
celLR = Range("AE" & 102).End(xlUp).Row
visLR = Range("AS" & 102).End(xlUp).Row
MCrdLR = Range("BQ" & 102).End(xlUp).Row
    
If Target.Column = 5 Or Target.Column = 9 Then
    If UCase(Range("E" & Target.Row)) = UCase("Op. Ep.") _
       And Range("I" & Target.Row) <> "" Then
            Range("Q" & savLR + 1) = Range("C" & Target.Row)
            Range("U" & savLR + 1) = Range("G" & Target.Row)
            Range("Y" & savLR + 1) = Range("I" & Target.Row)
    End If
End If

If Target.Column = 19 Or Target.Column = 23 Then
    If UCase(Range("S" & Target.Row)) = UCase("Vir. Ep. => Ch.") _
       And Range("W" & Target.Row) <> "" Then
            Range("C" & chqLR + 1) = Range("Q" & Target.Row)
            Range("G" & chqLR + 1) = Range("U" & Target.Row)
            Range("K" & chqLR + 1) = Range("W" & Target.Row)
    End If
End If

If Target.Column = 5 Or Target.Column = 9 Then
    If UCase(Range("E" & Target.Row)) = UCase("Vir. Ch. => Céli") _
       And Range("I" & Target.Row) <> "" Then
            Range("AE" & celLR + 1) = Range("C" & Target.Row)
            Range("AI" & celLR + 1) = Range("G" & Target.Row)
            Range("AM" & celLR + 1) = Range("I" & Target.Row)
    End If
End If

If Target.Column = 33 Or Target.Column = 37 Then
    If UCase(Range("AG" & Target.Row)) = UCase("Vir. Céli => Ch.") _
       And Range("AK" & Target.Row) <> "" Then
            Range("C" & chqLR + 1) = Range("AE" & Target.Row)
            Range("G" & chqLR + 1) = Range("AI" & Target.Row)
            Range("K" & chqLR + 1) = Range("AK" & Target.Row)
    End If
End If

If Target.Column = 19 Or Target.Column = 23 Then
    If UCase(Range("S" & Target.Row)) = UCase("Vir. Ep. => Céli") _
       And Range("W" & Target.Row) <> "" Then
            Range("AE" & celLR + 1) = Range("Q" & Target.Row)
            Range("AI" & celLR + 1) = Range("U" & Target.Row)
            Range("AM" & celLR + 1) = Range("W" & Target.Row)
    End If
End If

If Target.Column = 5 Or Target.Column = 9 Then
    If UCase(Range("E" & Target.Row)) = UCase("Visa") _
       And Range("I" & Target.Row) <> "" Then
            Workbook("Visa.xlsx").Worksheets(1).Range("C" & visLR + 1) = Range("C" & Target.Row)
            Workbook("Visa.xlsx").Worksheets(1).Range("G" & visLR + 1) = Range("G" & Target.Row)
            Workbook("Visa.xlsx").Worksheets(1).Range("K" & visLR + 1) = Range("I" & Target.Row)
    End If
End If

If Target.Column = 7 Or Target.Column = 9 Then
    If UCase(Range("G" & Target.Row)) = UCase("Paiement MasterCard") _
       And Range("I" & Target.Row) <> "" Then
            Range("BC" & MCrdLR + 1) = Range("C" & Target.Row)
            Range("BG" & MCrdLR + 1) = Range("G" & Target.Row)
            Range("BK" & MCrdLR + 1) = Range("I" & Target.Row)
    End If
End If


Application.EnableEvents = True
End Sub

Pourriez-vous m'aider à trouver une solution, s.v.p.

Merci à l'avance,

Camaalot

[EricDgn]

Bonjour,

Quelque chose de ce genre devrait faire le travail

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
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim chqLR As Long, savLR As Long, celLR As Long, visLR As Long, MCrdLR As Long
    Dim wbVisa As Workbook
'...
If Target.Column = 5 Or Target.Column = 9 Then
    If UCase(Range("E" & Target.Row)) = UCase("Visa") _
       And Range("I" & Target.Row) <> "" Then
            '--- initialise dossier Visa.xlsx
            On Error Resume Next
            Set wbVisa = Workbooks("Visa.xlsx")
            If Err.Number <> 0 Then
                '--- fichier Visa.xlsx pas encore ouvert
                Set wbVisa = Workbooks.Open(ThisWorkbook.Path & "\Visa.xlsx")
                Err.Clear
            End If
            On Error GoTo 0
            '--- passe les valeurs
            With wbVisa.Worksheets(1)          '--- à adapter, p.ex:  wbVisa.Worksheets(ActiveSheet.Name)
                visLR = .Range("AS" & 102).End(xlUp).Row
                .Range("C" & visLR + 1) = Range("C" & Target.Row)
                .Range("G" & visLR + 1) = Range("G" & Target.Row)
                .Range("K" & visLR + 1) = Range("I" & Target.Row)
            End With
            Set wbVisa = Nothing
    End If
End If
'...
End Sub

Cordialement.

[Glorian]

EricDgn, bonjour.

Eh bien merci pour votre solution qui réponds en partie à mon problème.

En partie, parce que elle fait ce que j'ai besoin qu'elle fasse.

Mais, il y avait un petit problème. Il fallait que les valeurs s'inscrivent à la prochaine ligne disponible dans le tableau.
Par contre, les valeurs passées s'inscrivaient à la mauvaise place !!!

La solution était de rectifier :

Code :

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

1
2
3
4
5
6
With wbVisa.Worksheets(1)          '--- à adapter, p.ex:  wbVisa.Worksheets(ActiveSheet.Name)
                visLR = .Range("AS" & 102).End(xlUp).Row
                .Range("C" & visLR + 1) = Range("C" & Target.Row)
                .Range("G" & visLR + 1) = Range("G" & Target.Row)
                .Range("K" & visLR + 1) = Range("I" & Target.Row)
            End With

Changer "AS" pour "C" dans visLR = .Range("AS" & 102).End(xlUp).Row. Boum ! C'est réglé

Maintenant, si vous le pouvez, j'aimerais avancer un peu plus et vous demander ceci :

Comment puis-je quand la colonne Catégories, s'ajoute le type de transfert ? Exemple, si je fais un transfert du compte chèque au compte Épargne, il s'inscrira dans la colonne "S" Catégories, Vir. Ch. => Ep.

La même chose pour le classeur Visa.xlsx, s'inscrira dans la colonne "E" Visa - Paiement.

Bonne journée et merci pour votre réponse,

Camaalot

[Glorian]

J'ajoute les fichiers...

Merci encore,

Camaalot

[EricDgn]

Bonjour,

Je n'ai pas vraiment compris votre demande, mais voilà toujours quelque chose.
La partie Visa ayant été supprimé de la feuille, la partie Mastercard est déplacée.
Il me semble indiqué de nommer les onglets selon les mois, cela dans les 2 fichiers, pour que les reports s'effectuent toujours correctement.
J'ai ajouté un code pour permettre de "corriger" une faute de frappe sans que cela crée une nouvelle ligne dans un autre compte. Il faudra cependant aller faire cette correction au 2e endroit quand c'est nécessaire.

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
Option Explicit
 
Dim vOldValue As Variant
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim chqLR As Long, savLR As Long, celLR As Long, visLR As Long, MCrdLR As Long
    Dim wbVisa As Workbook
 
If vOldValue <> "" Then Exit Sub    '--- évite création nouvelle ligne en cas de simple correction
 
If Target.Row < 6 Or Target.Row > 102 Then Exit Sub
 
chqLR = Range("C" & 102).End(xlUp).Row
savLR = Range("Q" & 102).End(xlUp).Row
celLR = Range("AE" & 102).End(xlUp).Row
MCrdLR = Range("AS" & 102).End(xlUp).Row
 
If Target.Column = 5 Or Target.Column = 7 Or Target.Column = 9 Then
    '--- compte chèque
    If Range("I" & Target.Row) = "" Then Exit Sub
 
    If UCase(Range("E" & Target.Row)) = UCase("Op. Ep.") Then
        '--- vers compte épargne
        Range("Q" & savLR + 1) = Range("C" & Target.Row)
        Range("S" & savLR + 1) = Range("E" & Target.Row)
        Range("U" & savLR + 1) = Range("G" & Target.Row)
        Range("Y" & savLR + 1) = Range("I" & Target.Row)
 
    ElseIf UCase(Range("E" & Target.Row)) = UCase("Vir. Ch. => Céli") Then
        '--- vers compte Céli
        Range("AE" & celLR + 1) = Range("C" & Target.Row)
        Range("AG" & celLR + 1) = Range("E" & Target.Row)
        Range("AI" & celLR + 1) = Range("G" & Target.Row)
        Range("AM" & celLR + 1) = Range("I" & Target.Row)
 
    ElseIf UCase(Range("E" & Target.Row)) = UCase("Visa") Then
        '--- vers compte Visa
        '--- initialise dossier Visa.xlsx
        On Error Resume Next
        Set wbVisa = Workbooks("Visa.xlsx")
        If Err.Number <> 0 Then
            '--- fichier Visa.xlsx pas encore ouvert
            Set wbVisa = Workbooks.Open(ThisWorkbook.Path & "\Visa.xlsx")
            Err.Clear
        End If
        On Error GoTo 0
        '--- passe les valeurs
        With wbVisa.Worksheets(ActiveSheet.Name)
            visLR = .Range("C" & 102).End(xlUp).Row
            .Range("C" & visLR + 1) = Range("C" & Target.Row)
            .Range("E" & visLR + 1) = Range("E" & Target.Row)
            .Range("G" & visLR + 1) = Range("G" & Target.Row)
            .Range("K" & visLR + 1) = Range("I" & Target.Row)
        End With
        Set wbVisa = Nothing
 
    ElseIf UCase(Range("G" & Target.Row)) = UCase("Paiement MasterCard") Then
        '--- vers compte Mastercard
        '--- visa supprimé ==> Mastercard déplacé --- à vérifier
        Range("AS" & MCrdLR + 1) = Range("C" & Target.Row)
        Range("AU" & MCrdLR + 1) = Range("E" & Target.Row)
        Range("AW" & MCrdLR + 1) = Range("G" & Target.Row)
        Range("BA" & MCrdLR + 1) = Range("I" & Target.Row)  '--- ?
    End If
 
ElseIf Target.Column = 19 Or Target.Column = 23 Then
    '--- compte épargne
    If Range("W" & Target.Row) = "" Then Exit Sub
 
    If UCase(Range("S" & Target.Row)) = UCase("Vir. Ep. => Ch.") Then
        '--- vers compte chèque
        Range("C" & chqLR + 1) = Range("Q" & Target.Row)
        Range("E" & chqLR + 1) = Range("S" & Target.Row)
        Range("G" & chqLR + 1) = Range("U" & Target.Row)
        Range("K" & chqLR + 1) = Range("W" & Target.Row)
 
    ElseIf UCase(Range("S" & Target.Row)) = UCase("Vir. Ep. => Céli") Then
        '--- vers compte Céli
        Range("AE" & celLR + 1) = Range("Q" & Target.Row)
        Range("AG" & celLR + 1) = Range("S" & Target.Row)
        Range("AI" & celLR + 1) = Range("U" & Target.Row)
        Range("AM" & celLR + 1) = Range("W" & Target.Row)
    End If
 
ElseIf Target.Column = 33 Or Target.Column = 37 Then
    '--- compte Céli
    If Range("AK" & Target.Row) = "" Then Exit Sub
 
    If UCase(Range("AG" & Target.Row)) = UCase("Vir. Céli => Ch.") Then
        '--- vers compte chèque
        Range("C" & chqLR + 1) = Range("AE" & Target.Row)
        Range("E" & chqLR + 1) = Range("AG" & Target.Row)
        Range("G" & chqLR + 1) = Range("AI" & Target.Row)
        Range("K" & chqLR + 1) = Range("AK" & Target.Row)
    End If
 
End If
 
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count = 1 Then vOldValue = Target.Value
End Sub

Cordialement.