recopier les valeur en fonction de combobox en cascade

Bon là je vous file tout mon code mais y a qu'une partie qui fonctionne pas et c'est :

Code:

1
2
3
4
 If Worksheets("Base").Cells(i, 1) = ComboBox1.Value And Worksheets("Base").Cells(i, 2) = ComboBox2.Value Then
    Worksheets("Base").Range("C" & i & ":F" & i & "").Copy
    Worksheets("impression").Range("C" & K + 4 & "").Select
    ActiveSheet.Paste

et

Code:

1
2
3
4
 If Worksheets("Base").Cells(i, 1) = ComboBox1.Value And Worksheets("Base").Cells(i, 2) = ComboBox2.Value And Worksheets("Base").Cells(i, 3) = ComboBox3.Value Then
    Worksheets("Base").Range("D" & i & ":F" & i & "").Copy
    Worksheets("impression").Range("D" & K + 5 & "").Select
    ActiveSheet.Paste

Ces deux codes doivent venir copier une partie de mes données dans ma feuil "Base" en fonction de combobox en cascade. Puis il les recopie dans une autre feuil que j'ai nommé imprimé.

Quand je fais fonctionner la première combobox ya pas de soucis car je n'en gère qu'une, par contre c'est pour les suivante qu'il y a un problème.

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
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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
Option Explicit
 
Dim Ws As Worksheet
Dim NbLignes As Integer
Dim K As Integer
Dim i As Integer
Dim LaDerniere As Integer
Dim j As Integer
Dim b_existe As Boolean
Dim f As Integer
Dim lg As Long
 
 
Function IsExist(ByVal NameSheet As String) As Boolean
    Dim oSheet As Worksheet
 
For Each oSheet In ThisWorkbook.Sheets
    If oSheet.Name = NameSheet Then
    IsExist = True: Exit For
    End If
Next oSheet
 
End Function
Private Sub CommandButton1_click()
 
 
 
If Not IsExist("impression") Then
Sheets.Add: ActiveSheet.Name = "impression"
Else
Worksheets("impression").Delete
Sheets.Add: ActiveSheet.Name = "impression"
End If
 
LaDerniere = Worksheets("Base").Cells(56500, 2).End(xlUp).Row
K = 1
For i = 2 To LaDerniere
 
If ComboBox2.Value = "" And ComboBox3.Value = "" And ComboBox4.Value = "" Then
 
    If Worksheets("Base").Cells(i, 1) = ComboBox1.Value Then
    Worksheets("Base").Range("B" & i & ":F" & i & "").Copy
    Worksheets("impression").Range("B" & K + 3 & "").Select
    ActiveSheet.Paste
    Worksheets("impression").Range("A2") = "Section : " & ComboBox1.Value
    Range("A2").Select
        With Selection.Interior
        .ColorIndex = 40
        .Pattern = xlSolid
    End With
    Worksheets("Base").Range("B1:D1").Copy
    Worksheets("impression").Range("B2:D2").Select
    ActiveSheet.Paste
    K = K + 1
    End If
 
ElseIf ComboBox3.Value = "" And ComboBox4.Value = "" Then
 
    If Worksheets("Base").Cells(i, 1) = ComboBox1.Value And Worksheets("Base").Cells(i, 2) = ComboBox2.Value Then
    Worksheets("Base").Range("C" & i & ":F" & i & "").Copy
    Worksheets("impression").Range("C" & K + 4 & "").Select
    ActiveSheet.Paste
    Worksheets("impression").Range("A2") = "Section : " & ComboBox1.Value
    Worksheets("impression").Range("B3") = "Date : " & ComboBox2.Value
    Range("A2,B3").Select
    With Selection.Interior
        .ColorIndex = 40
        .Pattern = xlSolid
    End With
    Worksheets("Base").Range("C1:D1").Copy
    Worksheets("impression").Range("C3:D3").Select
    ActiveSheet.Paste
    K = K + 1
    End If
 
ElseIf ComboBox4.Value = "" Then
 
    If Worksheets("Base").Cells(i, 1) = ComboBox1.Value And Worksheets("Base").Cells(i, 2) = ComboBox2.Value And Worksheets("Base").Cells(i, 3) = ComboBox3.Value Then
    Worksheets("Base").Range("D" & i & ":F" & i & "").Copy
    Worksheets("impression").Range("D" & K + 5 & "").Select
    ActiveSheet.Paste
    Worksheets("impression").Range("A2") = "Section : " & ComboBox1.Value
    Worksheets("impression").Range("B3") = "Date : " & ComboBox2.Value
    Worksheets("impression").Range("C3") = "Contrat : " & ComboBox3.Value
    Range("A2,B3,C4").Select
    With Selection.Interior
        .ColorIndex = 40
        .Pattern = xlSolid
    End With
    Worksheets("Base").Range("D1").Copy
    Worksheets("impression").Range("D3").Select
    ActiveSheet.Paste
    K = K + 1
    End If
 
ElseIf Not (ComboBox4.Value = "") Then
    If Worksheets("Base").Cells(i, 4) = ComboBox4.Value Then
    Worksheets("Base").Range("E" & i & ":F" & i & "").Copy
    Worksheets("impression").Range("E" & K + 6 & "").Select
    ActiveSheet.Paste
        Worksheets("impression").Range("A2") = "Section : " & ComboBox1.Value
    Worksheets("impression").Range("B3") = "Date : " & ComboBox2.Value
    Worksheets("impression").Range("C4") = "Contrat : " & ComboBox3.Value
    Worksheets("impression").Range("D5") = "Equipement : " & ComboBox4.Value
    Range("A2,B3,C4,D5").Select
    With Selection.Interior
        .ColorIndex = 40
        .Pattern = xlSolid
    End With
    K = K + 1
    End If
 
End If
 
Next i
With Sheets("impression")
lg = .Range("D" & .Rows.Count).End(xlUp).Row
.Range("D" & lg + 1) = "Coût total = " & Application.WorksheetFunction.Sum(.Range("D4:d" & lg)) & "€" 'd2 si la somme commence à D2
End With
UserForm1.Hide
End Sub
 
 
Private Sub UserForm_Initialize()
Dim j As Long
Dim kol As New Collection
 
Set Ws = Worksheets("Base")
With Ws
NbLignes = .Cells(.Rows.Count, 1).End(xlUp).Row
For j = 2 To NbLignes
    On Error Resume Next
    kol.Add .Range("A" & j).Value, CStr(.Range("A" & j).Value)
Next j
End With
For j = 1 To kol.Count
    Me.ComboBox1.AddItem kol(j)
Next j
End Sub
 
Private Sub ComboBox1_Change()
Dim j As Long
Dim kol As New Collection
With Ws
For j = 2 To NbLignes
    On Error Resume Next
    If CStr(.Range("A" & j).Value) = Me.ComboBox1.Value Then kol.Add .Range("B" & j).Value, CStr(.Range("B" & j).Value)
Next j
End With
Me.ComboBox2.Clear
For j = 1 To kol.Count
    Me.ComboBox2.AddItem kol(j)
Next j
End Sub
 
Private Sub ComboBox2_Change()
Dim j As Long
Dim kol As New Collection
With Ws
For j = 2 To NbLignes
    On Error Resume Next
    If CStr(.Range("A" & j).Value) = Me.ComboBox1.Value And CStr(.Range("B" & j).Value) = Me.ComboBox2.Value Then kol.Add .Range("C" & j).Value, CStr(.Range("C" & j).Value)
Next j
End With
Me.ComboBox3.Clear
For j = 1 To kol.Count
    Me.ComboBox3.AddItem kol(j)
Next j
End Sub
 
Private Sub ComboBox3_Change()
Dim j As Long
Dim kol As New Collection
With Ws
For j = 2 To NbLignes
    On Error Resume Next
    If CStr(.Range("A" & j).Value) = Me.ComboBox1.Value And CStr(.Range("B" & j).Value) = Me.ComboBox2.Value And CStr(.Range("C" & j).Value) = Me.ComboBox3.Value Then kol.Add .Range("D" & j).Value, CStr(.Range("D" & j).Value)
Next j
End With
Me.ComboBox4.Clear
For j = 1 To kol.Count
    Me.ComboBox4.AddItem kol(j)
Next j
End Sub

Re,
rien que dans ton code, prends la facilité, au lieu de
Code:

1 2 3 4 If Worksheets("Base").Cells(i, 1) = ComboBox1.Value And Worksheets("Base").Cells(i, 2) = ComboBox2.Value Then Worksheets("Base").Range("C" & i & ":F" & i & "").Copy Worksheets("impression").Range("C" & K + 4 & "").Select ActiveSheet.Paste
préfères
Code:

1 2 3 If Worksheets("Base").Cells(i, 1) = ComboBox1.Value And Worksheets("Base").Cells(i, 2) = ComboBox2.Value Then sheets("impression").Range(....)=sheets("Base").Range("...) ..............
mais comme je ne connais pas les valeurs de tes variables i et K...
c'est de toute façon mal rédigé

Code:

Range("C" & i & ":F" & i & "")

, ne serait-ce pas :

Code:

Range("C" & i , "F" & i )

et ça :

Code:

Range("C" & K + 4 & "")

K c'est quoi ?

K est une variable qui me permet de placer mes lignes sélectionné dans Base là ou je le souhaite dans Impression.:mrgreen:

Sinon pour le code j'ai essyé ça ne marche plus même pour la combobox1 alors que tout a l'heure ça marchait 8O

Je te met le code comme je l'ai modifié.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub CommandButton1_click()
 
....
 
LaDerniere = Worksheets("Base").Cells(56500, 2).End(xlUp).Row
K = 1
For i = 2 To LaDerniere
 
If ComboBox2.Value = "" And ComboBox3.Value = "" And ComboBox4.Value = "" Then
    If Worksheets("Base").Cells(i, 1) = ComboBox1.Value Then
    Sheets("impression").Range("B" & K + 4 & "") = Sheets("Base").Range("B" & i, "F" & i)
    Worksheets("impression").Range("A2") = "Section : " & ComboBox1.Value
    Range("A2").Select
        With Selection.Interior
        .ColorIndex = 40
        .Pattern = xlSolid
    End With
    Worksheets("Base").Range("B1:D1").Copy
    Worksheets("impression").Range("B2:D2").Select
    ActiveSheet.Paste
    K = K + 1
    End If
.....

Je sais pas comment faire pourtant qui s'est que je me casse la tête:oops:

Bonsoir,
Comme je ne peux toujours pas regarder ton fichier, remplace au moins cette ligne :

Code:

Sheets("impression").Range("B" & K + 4 & "") = Sheets("Base").Range("B" & i, "F" & i

par

Code:

Sheets("impression").Range("B" & k + 4, "f" & k + 4) = Sheets("Base").Range("B" & i, "F" & i)

bonne soirée