Private Sub Worksheet_Activate()
Worksheet_Change [C2] 'lance la macro
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C2]) Is Nothing Then Exit Sub
Dim nom$, col As Variant, dercel As Range, P As Range, c As Range
nom = [C2]
Application.ScreenUpdating = False
Range("A5:E" & Rows.Count).Delete xlUp 'RAZ
With Sheets("Global")
col = Application.Match(nom, .Rows(3), 0)
If IsError(col) Then Exit Sub
Set dercel = .Cells.SpecialCells(xlCellTypeLastCell)
'---traitement des cellules fusionnées---
Set P = .Range("B4:C" & dercel.Row)
P.Copy P.Offset(, dercel.Column) 'pour mémoriser
For Each c In P
If c <> "" And c.MergeCells Then
With c.MergeArea
.UnMerge 'défusionne
c.Copy .Cells
.Borders.Weight = xlThin 'bordures
End With
End If
Next
'---filtrage---
With .Range("B3", dercel)
.Columns(col - 1).Font.Bold = False 'non gras
.Cells(2, .Columns.Count + 1) = "=" & .Cells(2, col - 1).Address(0, 0) & "<>""""" 'critère de filtrage
[D4] = nom
.Cells(2, .Columns.Count + 1) = "" 'RAZ
.AdvancedFilter xlFilterCopy, .Cells(1, .Columns.Count + 1).Resize(2), [A4:D4] 'filtre avancé copié vers A4:D4
[D4] = "Quantité souhaitée"
End With
'---remise en état---
With P.Offset(, dercel.Column)
.Copy P
.Delete xlToLeft
End With
With .UsedRange: End With
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub