VBA : recopie de ligne avec condition PB?

Version imprimable

Bonjour

Je suis en panne d'inspiration et de fonctionnement sur ceci:

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
36
37
38
39
40
41
42
43
44
45
46
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim CCS1 As Integer
    Dim CCS2 As Integer
 
 
    Dim Dest1 As Worksheet
    Dim Dest2 As Worksheet
 
    Dim LigneDestination As Integer
 
 
    Set Dest1 = Worksheets("Feuil2")
    Set Dest2 = Worksheets("Feuil3")
    Set CCS1 = 9
    Set CCS2 = 9
 
Function RC1()
 
    If Target.Count > 1 Then Exit Function
    If Target.Column = CCS1 Then
        If UCase(Target.Value) = "C" Then
            Range("B" & Target.Row).Resize(2, 8).Copy
            ActiveSheet.Paste Destination:=Dest1.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
            Application.CutCopyMode = False
 
        End If
        End If
        End If
End Function
 
Function RC2()
    If Target.Count > 1 Then Exit Function
    If Target.Column = CCS2 Then
    If UCase(Target.Value) = "SC" Then
            Range("B" & Target.Row).Resize(2, 8).Copy
     ActiveSheet.Paste Destination:=Destination.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
            Application.CutCopyMode = False
 
    End If
    End If
    End If
 
End Function
End Sub

Merci d'avance pour vôtre aide

17/12/2013, 23h57
Marc-L

Bonjour,

je suis en panne de décodeur, de boule de cristal et autres incantations divinatoires & magiques ‼

Commencer déjà par éditer le message et de baliser le code avec l'icône # dédiée, cf règles de ce forum !

Ensuite, une présentation claire et exhaustive de la problématique est de rigueur, sinon consulter Mme Irma ‼

Cordialement.

recopie ligne avec condition PB

Bonjour,

Code bizarre qui englobe les deux "functions" dans la "sub worksheet....."

je suppose que l'intention est d'appeler les "function" à partir de la sub ?

si tel est le cas, mettre "end sub" avant "function rc1" et dans cette "sub " prévoir les appels aux "function".

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
36
37
38
39
40
41
42
43
44
 
 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim CCS1 As Integer
Dim CCS2 As Integer
 
Dim Dest1 As Worksheet
Dim Dest2 As Worksheet
 
Dim LigneDestination As Integer
 
Set Dest1 = Worksheets("Feuil2")
Set Dest2 = Worksheets("Feuil3")
Set CCS1 = 9
Set CCS2 = 9
Call RC1 ' avec ou sans passage d'arguments
Call RC2 ' avec ou sans passage d'arguments
End Sub
 
Function RC1()
If Target.Count > 1 Then Exit Function
    If Target.Column = CCS1 Then
        If UCase(Target.Value) = "C" Then
            Range("B" & Target.Row).Resize(2, 8).Copy
            ActiveSheet.Paste Destination:=Dest1.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
            Application.CutCopyMode = False
        End If
    End If
End If
End Function
 
Function RC2()
If Target.Count > 1 Then Exit Function
    If Target.Column = CCS2 Then
        If UCase(Target.Value) = "SC" Then
            Range("B" & Target.Row).Resize(2, 8).Copy
            ActiveSheet.Paste Destination:=Destination.Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
            Application.CutCopyMode = False
        End If
    End If
End If
End Function

Cordialement,