Private Sub Worksheet_Activate()
Dim An, a, c As Range, deb As Range, n%, dercol%, P As Range
An = Application.InputBox("Entrez les années séparées par un espace :")
If An = False Then Exit Sub
Application.ScreenUpdating = False
Cells.Delete 'RAZ
With Feuil1
For Each a In Split(An)
If Application.CountIf(.Rows(3), Val(a)) Then
.Columns(1).Copy [A1]
If deb Is Nothing Then Set deb = [B1]
For Each c In .Rows(3).SpecialCells(xlCellTypeConstants)
If c = Val(a) Then
n = c.MergeArea.Columns.Count
c.MergeArea.EntireColumn.Copy deb
deb(2) = c(0).MergeArea(1)
With deb(2).Resize(, n)
.HorizontalAlignment = xlCenterAcrossSelection
.Interior.Color = vbCyan
.BorderAround Weight:=xlThin 'pourtour
End With
Set deb = deb.Offset(, n)
End If
Next c
End If
Next a
End With
'---place GMS à droite---
dercol = UsedRange.Columns.Count
For n = 1 To dercol
If Cells(2, n) = "GMS" Then Set P = Union(IIf(P Is Nothing, Cells(3, n).MergeArea.EntireColumn, P), Cells(3, n).MergeArea.EntireColumn)
Next
If Not P Is Nothing Then
P.Copy Columns(dercol + 1)
P.Delete
End If
Rows("20:" & Rows.Count).Delete 'adapter au besoin
End Sub