Bonjour,

Je voudrais faire un programme VBA qui me permette de copier les lignes d'une feuille vers une autre dans le même classeur en fonction de condition sur 2 colonnes différentes.

Si ma la valeur de la cellule x présente dans la colonne BQ = "a" et la valeur de la cellule y présente dans la colonne BR = b (ou c ou d ...) alors copier cette ligne dans l'autre feuille.

J'ai fais un code mais le problème est que la macro copie seulement la première ligne ou une des condition est remplie puis il s'arrete et ne valide pas les autres condition jusqu'a la fin du tableau???

Je vous remercie pour votre aide

voici mon code:

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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
Sub checkinterco()
 
Dim i As Integer
Dim j As Integer
j = 6
 
 
Worksheets("Feuil1").Range("A7:CP2000").ClearContents
 
 
Sheets("SFORL West Europe CS - TMN C4").Select
    ActiveWindow.SelectedSheets.Delete
 
    Workbooks.Open Filename:="D:\Mes Documents\funnel highlight\spade data_last week.xls"
    Sheets("SFORL West Europe CS - TMN C4").Select
    Sheets("SFORL West Europe CS - TMN C4").Copy After:=Workbooks("checkintrainterflag.xls").Sheets(1)
    Windows("spade data_last week.xls").Activate
    ActiveWindow.Close
 
 
Worksheets("SFORL West Europe CS - TMN C4").Select
Rows("1:1").Select
Selection.AutoFilter
Range("CP1").Value = "Check interco"
 
 
'external
For i = 2 To 2000
 
        If Cells(i, 69).Value = "None" And Cells(i, 70).Value <> "N/A" Then
        Rows(i).Copy
        Sheets("Feuil1").Select
        Range("A" & j).Select
        ActiveSheet.Paste
        End If
 
'intersbu
 
        If Cells(i, 69).Value = "Inter SBU" And Cells(i, 70).Value <> "Sogeti" Then
        Rows(i).Copy
        Sheets("Feuil1").Select
        Range("A" & j).Select
        ActiveSheet.Paste
        End If
 
 
        If Cells(i, 69).Value = "Inter SBU" And Cells(i, 70).Value <> "CEA - Finland TS OS" Then
        Rows(i).Copy
        Sheets("Feuil1").Select
        Range("A" & j).Select
        ActiveSheet.Paste
        End If
 
        If Cells(i, 69).Value = "Inter SBU" And Cells(i, 70).Value <> "CEA - CE TS GE/CH" Then
        Rows(i).Copy
        Sheets("Feuil1").Select
        Range("A" & j).Select
        ActiveSheet.Paste
        End If
 
        If Cells(i, 69).Value = "Inter SBU" And Cells(i, 70).Value <> "CEA - CEA CS" Then
        Rows(i).Copy
        Sheets("Feuil1").Select
        Range("A" & j).Select
        ActiveSheet.Paste
        End If
 
        If Cells(i, 69).Value = "Inter SBU" And Cells(i, 70).Value <> "CEA - Netherlands TS" Then
        Rows(i).Copy
        Sheets("Feuil1").Select
        Range("A" & j).Select
        ActiveSheet.Paste
        End If
 
        If Cells(i, 69).Value = "Inter SBU" And Cells(i, 70).Value <> "CEA - Belgium TS" Then
        Rows(i).Copy
        Sheets("Feuil1").Select
        Range("A" & j).Select
        ActiveSheet.Paste
        End If
 
        If Cells(i, 69).Value = "Inter SBU" And Cells(i, 70).Value <> "CEA - Eastern Europe" Then
        Rows(i).Copy
        Sheets("Feuil1").Range("A" & i).Select
        ActiveSheet.Paste
        End If
 
        If Cells(i, 69).Value = "Inter SBU" And Cells(i, 70).Value <> "OS - OS Europe" Then
        Rows(i).Copy
        Sheets("Feuil1").Select
        Range("A" & j).Select
        ActiveSheet.Paste
        End If
 
 
'intrasbu
 
        If Cells(i, 69).Value = "Intra SBU" And Cells(i, 70).Value <> "WE - France TS" Then
        Rows(i).Copy
        Sheets("Feuil1").Select
        Range("A" & j).Select
        ActiveSheet.Paste
        End If
 
        If Cells(i, 69).Value = "Intra SBU" And Cells(i, 70).Value <> "WE - WE CS" Then
        Rows(i).Copy
        Sheets("Feuil1").Select
        Range("A" & j).Select
        ActiveSheet.Paste
        End If
 
        If Cells(i, 69).Value = "Intra SBU" And Cells(i, 70).Value <> "WE - Iberia TS OS" Then
        Rows(i).Copy
        Sheets("Feuil1").Select
        Range("A" & j).Select
        ActiveSheet.Paste
        End If
 
'intragou
 
 
        If Cells(i, 69).Value = "Intra GOU" And Cells(i, 70).Value = "FR Capgemini CS" Then
        Rows(i).Copy
        Sheets("Feuil1").Select
        Range("A" & j).Select
        ActiveSheet.Paste
        End If
 
Next i
        j = j + 1
 
 
 
End Sub