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
|
Private Sub Worksheet_Activate()
'
' Macro1 Macro
'
Dim Fin As Long
'
Range("E6:E240").Select
'si 240 = fixe
' Fin = 240
'
' ou si la dernière cellule varie enlever la ligne "fin=240" et mettre les 2 lignes ci-dessous en enlevant le '
Fin = Range("E" & Rows.Count).End(xlUp).Row
Range("E6:E" & Fin).Select
'
Selection.Copy
Range("AK6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("AK6"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("AK6:AK" & Fin)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'
Sheets("Feuil2").Select
With Range("A1").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=("=Feuil1!AK6:AK" & Fin)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End Sub |
Partager