XL 2013 VBA pour transférer des valeurs d'un tableau à l'autre

Camaalot

XLDnaute Nouveau
Bonjour,

J'ai écrit ce petit VBA qui permet de transférer des valeurs d'un compte à l'autre.

Code:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim chqLR As Long, savLR As Long, celLR As Long, marLR As Long
   
   
If Target.Row < 6 Or Target.Row > 102 Then Exit Sub
If Target.Column <> 7 And Target.Column <> 9 And Target.Column <> 19 And Target.Column <> 21 Then Exit Sub

Application.EnableEvents = False

chqLR = Range("C" & 102).End(xlUp).Row
savLR = Range("Q" & 102).End(xlUp).Row
celLR = Range("AC" & 102).End(xlUp).Row
marLR = Range("AO" & 102).End(xlUp).Row
   
If Target.Column = 7 Or Target.Column = 9 Then
    If UCase(Range("G" & Target.Row)) = UCase("Virement Chèque-Épargne") _
       And Range("I" & Target.Row) <> "" Then
            Range("Q" & savLR + 1) = Range("C" & Target.Row)
            Range("S" & savLR + 1) = Range("G" & Target.Row)
            Range("W" & savLR + 1) = Range("i" & Target.Row)
    End If
End If

If Target.Column = 19 Or Target.Column = 21 Then
    If UCase(Range("S" & Target.Row)) = UCase("Virement Épargne-Chèque") _
       And Range("U" & Target.Row) <> "" Then
            Range("C" & chqLR + 1) = Range("Q" & Target.Row)
            Range("G" & chqLR + 1) = Range("S" & Target.Row)
            Range("K" & chqLR + 1) = Range("U" & Target.Row)
    End If
End If

If Target.Column = 7 Or Target.Column = 9 Then
    If UCase(Range("G" & Target.Row)) = UCase("Virement Chèque-Céli") _
       And Range("I" & Target.Row) <> "" Then
            Range("AC" & celLR + 1) = Range("C" & Target.Row)
            Range("AE" & celLR + 1) = Range("G" & Target.Row)
            Range("AI" & celLR + 1) = Range("I" & Target.Row)
    End If
End If

If Target.Column = 31 Or Target.Column = 33 Then
    If UCase(Range("AE" & Target.Row)) = UCase("Virement Céli-Chèque") _
       And Range("AG" & Target.Row) <> "" Then
            Range("C" & chqLR + 1) = Range("AC" & Target.Row)
            Range("G" & chqLR + 1) = Range("AE" & Target.Row)
            Range("K" & chqLR + 1) = Range("AG" & Target.Row)
    End If
End If

If Target.Column = 7 Or Target.Column = 9 Then
    If UCase(Range("G" & Target.Row)) = UCase("Virement Chèque-Marge") _
       And Range("I" & Target.Row) <> "" Then
            Range("AO" & celLR + 1) = Range("C" & Target.Row)
            Range("AQ" & celLR + 1) = Range("G" & Target.Row)
            Range("AU" & celLR + 1) = Range("i" & Target.Row)
    End If
End If

If Target.Column = 43 Or Target.Column = 45 Then
    If UCase(Range("AQ" & Target.Row)) = UCase("Virement Marge-Chèque") _
       And Range("AS" & Target.Row) <> "" Then
            Range("C" & marLR + 1) = Range("AO" & Target.Row)
            Range("G" & marLR + 1) = Range("AQ" & Target.Row)
            Range("K" & marLR + 1) = Range("AS" & Target.Row)
    End If
End If

Application.EnableEvents = True
End Sub

Le problème que je ne comprends pas c'est :
Pourquoi est-ce ce que j'arrive à transférer des valeurs de compte chèque à Épargne, vice versa mais je peux que transférer des valeurs du compte chèque à Céli et compte chèque à Marge et pas le contraire, soit Céli à Chèque et Marge à Chèque ?

Aussi, deuxième question :
Pourquoi les premières valeurs inscrites dans Marge de crédit apparaissent dans AO9 au lieu de AO7 ?

Merci pour vos réponse. Ce projet est important pour moi.

Camaalot
 

Pièces jointes

  • Virements comptes test.xlsm
    59.1 KB · Affichages: 28

Lone-wolf

XLDnaute Barbatruc
Bonjour Camaalot, le Forum :)

Pour le transfert de Compte chèque à Éparge et vice versa. Quand on utilise offset la valeur de la colonne principale (ici H ou T ) est zéro.

Colonnes H à S : H= 0 - I= 1 - J = 2 - K = 3 etc.
Colonnes S à C : S = 0 - R = -1 - Q = -2 - P = -3 etc.

Va doucement en comptant les colonnes pour ne pas faire d'erreurs.

Ici j'ai choisi SelectionChange moins contraignant; parce que avec Change quand tu fait une erreur, tu est obligé de fermer le classeur et recommencer.

Ceci n'est qu'un exemple. Utilise TAB du clavier pour tester.

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim chqLR As Long, savLR As Long, celLR As Long, marLR As Long


    If Not Intersect(Target, Columns("H:H")) Is Nothing Then
             '=COLONNE G
        If Target.Offset(0, -1) = "Virement Chèque-Épargne" Then
            Target.Offset(0, 11) = Target.Offset(0, -1)
            Target.Offset(0, 9) = Target.Offset(0, -5)
        End If
    End If

    If Not Intersect(Target, Columns("T:T")) Is Nothing Then
            '=COLONNE S
        If Target.Offset(0, -1) = "Virement Épargne-Chèque" Then
            Target.Offset(0, -13) = Target.Offset(0, -1)
            Target.Offset(0, -17) = Target.Offset(0, -3)
        End If
    End If
End Sub
 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re

Une autre façon de faire et à tester. Inscrit le montant dans l'une des colonnes du premier tableau.

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim derlig&, i&
    Application.EnableEvents = False

    If Not Intersect(Target, Columns("I:K")) Is Nothing Then
        If Target.Offset(0, 0) <> "" Then
            derlig = Range("m" & Rows.Count).End(xlUp).Row - 2

            For i = 7 To derlig
                If Cells(i, "M") = vbNullString Then
                    Exit For
                Else
                    Cells(i, "G") = IIf(Cells(i, "I") <> "", "Virement Épargne-Chèque", "Virement Chèque-Épargne")
                    Cells(i, "S") = IIf(Cells(i, "U") <> "", "Virement Épargne-Chèque", "Virement Chèque-Épargne")
                    Cells(i, "U") = Cells(i, "K")
                    Cells(i, "W") = Cells(i, "I")
                End If
            Next i
        End If
    End If
    Application.EnableEvents = True

End Sub
 

Discussions similaires

Réponses
14
Affichages
621

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG