Bonjour
voir mon code vba pour ajustement. Tout fonctionne, mais je ne suis pas certain de la macro événementiel que j'ai rajoutée à la fin du premier macro.
j'aimerais en fonction de la valeur d'une cellule (F4) sur la feuille active copier ligne entière sur la feuillle adresse.
Voir mon code actuel pour aide.
Merci

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
Private Sub ComboBox1_Change()
 Dim Derlg As Long, DD As Long, DF As Long
 Dim Sh As Worksheet
 
 Worksheets("Empl").Unprotect Password:="moncef"
 Worksheets("Master").Unprotect Password:="moncef"
 Worksheets("Master").Visible = True
 'On inhibe la mise à jour affichage écran
 Application.ScreenUpdating = False
 With Sheets("Empl")
 'On supprime l'éventuel filtre automatique
 .AutoFilterMode = False
 'La dernière ligne remplie de la colonna A
 Derlg = .Range("A" & .Rows.Count).End(xlUp).Row
 'Si ComboBox1 non vide
 If Me.ComboBox1.Value <> "" Then
 'En DD (date début), On transforme le contenu de DTPicker1 en Long
 DD = CLng(Me.DTPicker1.Value)
 'En DF (date Fin), on transforme le contenu de DTPicker2 en Long
 DF = CLng(Me.DTPicker2.Value)
 If DF > DD Then
 'On filtre la colonne A entre DD et DF
 .Range("A7:J" & Derlg).AutoFilter field:=1, Criteria1:=">=" & DD, Criteria2:="<=" & DF, Operator:=xlAnd
 'Et on filtre la colonne H sur le texte entrée dans ComboBox1
 .Range("A7:H" & Derlg).AutoFilter field:=8, Criteria1:=Me.ComboBox1.Text
 'Si le résultat du filtre comporte plus d'une ligne (y compris la ligne 7, celle des titres)
 If .Range("A7:A" & Derlg).SpecialCells(xlCellTypeVisible).Count > 1 Then
 On Error Resume Next
 'Si la feuille nommée par la valeur de ComboBox1 existe, on instancie dans Sh cette feuille
 Set Sh = Sheets(Me.ComboBox1.Text)
 On Error GoTo 0
 'Si la feuille nommée par la valeur de ComboBox1 n'existe pas, Sh est vide (nothing)
 If Sh Is Nothing Then
 'On crée une nouvelle feuille qu'on nomme par la valeur de ComboBox1
 Worksheets("Master").Copy After:=Sheets(Sheets.Count)
 Set Sh = ActiveSheet
 Sh.Name = Me.ComboBox1.Text
 End If
 'On copie le résultat issu du filtre dans la première ligne vide de la feuille Sh
 .Range("A8:F" & Derlg).SpecialCells(xlCellTypeVisible).Copy Sh.Cells(Sh.Rows.Count, 1).End(xlUp)(2)
 Set Sh = Nothing
 End If
 ActiveSheet.Select
 Columns("A:C").ColumnWidth = 18
 Columns("D:F").ColumnWidth = 10
 Columns("G:I").ColumnWidth = 18
 
 End If
 'On supprime le filtre automatique précédent
 .AutoFilterMode = False
 
 Range("A14:I65536").Sort Key1:=Range("A14"), Order1:=xlAscending, Header:= _
 xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
 DataOption1:=xlSortNormal
 
 End If
 
 End With
 Worksheets("Empl").Protect Password:="moncef"
 Worksheets("Master").Protect Password:="moncef"
 Worksheets("Master").Visible = False
 ActiveSheet.Protect Password:="moncef"
 Application.ScreenUpdating = True
 
 ActiveSheet.Select
 If Range("F4") = "Bourget" Then
 Worksheets("Adresse").Visible = True
 Worksheets("Adresse").Select
 Range("A2:H2").Copy
 Sheets("Bourget").Select
 Range("F3").Select
 Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
 False, Transpose:=True
 Range("F4").Select
 Worksheets("Adresse").Visible = False
 Application.ScreenUpdating = True
 End If
 If Range("F4") = "Bussey" Then
 Worksheets("Adresse").Visible = True
 Worksheets("Adresse").Select
 Range("A1:H1").Copy
 Sheets("Bussey").Select
 Range("F3").Select
 Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
 False, Transpose:=True
 Range("F4").Select
 Worksheets("Adresse").Visible = False
 Application.ScreenUpdating = True
 End If
 
 End Sub