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
|
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastLig As Long, NewLig As Long, Nb As Long
If Target.Address = "$A$2" Then
Union(Range("A4:H" & Rows.Count), Range("J4:K" & Rows.Count)).ClearContents
If Target <> "" Then
With Sheets("Général")
.Range("A3").AutoFilter
LastLig = .Cells(Rows.Count, "G").End(xlUp).Row
If LastLig < 4 Then
If .Range("A3").AutoFilter = True Then .Range("A3").AutoFilter
Exit Sub
End If
With .Range("A3:N" & LastLig)
.AutoFilter
.AutoFilter field:=7, Criteria1:=Target
End With
Nb = .Range("A3:A" & LastLig).SpecialCells(xlCellTypeVisible).Count - 1
If Nb > 0 Then
Application.EnableEvents = False
.Range("A4:F" & LastLig).SpecialCells(xlCellTypeVisible).Copy Range("A4")
.Range("I4:J" & LastLig).SpecialCells(xlCellTypeVisible).Copy Range("G4")
.Range("L4:M" & LastLig).SpecialCells(xlCellTypeVisible).Copy
.Range("J4").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.EnableEvents = True
End If
.Range("A3").AutoFilter
Range("A3").Select
End With
Range("A3").Select
ActiveWorkbook.Worksheets("P").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("P").Sort.SortFields.Add Key:=Range("K4:K299"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("P").Sort.SortFields.Add Key:=Range("B4:B299"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("P").Sort
.SetRange Range("A3:L500")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A3").Select
End If
End If
AutoFitSheet
End Sub |
Partager