Excel Macro VBA: Ajouter des valeurs dans des feuilles differents suivant des critères

Version imprimable

08/06/2018, 03h10
DFi100

1 pièce(s) jointe(s)

Excel Macro VBA: Ajouter des valeurs dans des feuilles differents suivant des critères

Bonjour,

J'aimerais une macro VBA qui permettrais de prendre que les valeurs (C8:H8) et de les metres dans la feuille définis par des critères. (voir fichier attaché)
Pour chaque ligne de valeurs introduit dans les feuilles, un retour a la ligne pour introduire les prochaines valeurs

Exemple:

SI critere 1 = A,B ou C ---> ALORS mettre les valeurs dans la feuille ABC
SI critere 1 = D ---> ET QUE critere 2 = DA ---> ALORS mettre les valeurs dans la feuille DA
SI critere 1 = D ---> ET QUE critere 2 = DB ---> ALORS mettre les valeurs dans la feuille DB
SI critere 1 = D ---> ET QUE critere 2 = DC ---> ET QUE critere 3 = USD ---> ALORS mettre les valeurs dans la feuille DC USD
SI critere 1 = D ---> ET QUE critere 2 = DC ---> ET QUE critere 3 = EUR ---> ALORS mettre les valeurs dans la feuille DC EUR
SI critere 1 = D ---> ET QUE critere 2 = DD ---> ALORS mettre les valeurs dans la feuille DD

Merci d'avance

1 pièce(s) jointe(s)

Bonjour DFi, bonjour le forum,

Double clique sur "SEND" dans ton fichier modifié en pièce jointe.
Le code du double-clic (dans le composant Feuil1 (Formulaire)):

Code:

1
2
3
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = "$G$3:$G$4" Then Module1.Macro1
End Sub

Le code de la copie dans le module Module1 :

Code:

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
Sub Macro1()
Dim OS As Worksheet
Dim OD As Worksheet
Dim C1 As String
Dim C2 As String
Dim C3 As String
Dim DEST As Range
 
Set OS = Worksheets("Formulaire")
C1 = OS.Range("C3").Value
C2 = OS.Range("C4").Value
C3 = OS.Range("C5").Value
Select Case C1
    Case "A", "B", "C"
        Set OD = Worksheets("ABC")
    Case "D"
        Select Case C2
            Case "DA"
                Set OD = Worksheets("DA")
            Case "DB"
                Set OD = Worksheets("DB")
            Case "DD"
                Set OD = Worksheets("DD")
            Case "DC"
                Select Case C3
                    Case "USD"
                        Set OD = Worksheets("DC USD")
                    Case "EUR"
                        Set OD = Worksheets("DC EUR")
                End Select
        End Select
End Select
If OD.Range("A1").Value = "" Then Set DEST = OD.Range("A1") Else Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
OS.Range("C8:H8").Copy DEST
End Sub

08/06/2018, 12h04
DFi100

Bonjour Thautheme,

Tout d'abord un grand merci pour le travail et la rapidité ;)

J'ai testé le fichier attaché tout fonctionne nickel mais il y a un bug quand je choisis les critères suivant:

Critère 1 = D
Critère 2 = DE

Erreur d'exécution "91": Variable objet ou variable de bloc With non définie

Après analyse du code, j'ai découvert l'erreur ;)

Case "DD"
Set OD = Worksheets("DD")

Au lieu de:

Case "DE"
Set OD = Worksheets("DE")

Encore un grand merci pour ce superbe boulot ;)

DFi100.
24/06/2018, 12h54
DFi100

Copier/coller que les valeurs sans leurs styles vers la DESTINATION (DEST)?

Bonjour Thautheme,

Reviens vers toi, car j'ai oublié de préciser que je voulais juste copier/coller les valeurs sans leurs styles vers la DESTINATION (DEST).
Pourrais-tu m'expliquer comment adapter la macro que tu as créer ?

Genre ceci : (code trouvé sur le net)

Range("").Select
Selection.Copy
Range("").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Merci

DFi100