Private Sub Worksheet_Activate()
[A1:J24].ClearContents
[B1].Resize(, [couleurs].Count) = Application.Transpose([couleurs])
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ligne = 2
For i = 1 To 20
Cells(ligne, 1) = Sheets("plansem1").[A4].Offset(i - 1)
For Each s In Array("plansem1", "plansem2")
Set f = Sheets(s)
For Each c In f.[b4].Offset(i - 1).Resize(, 190)
If c <> "" Then
Set result = [1:1].Find(c)
col = result.Column
If Cells(ligne, col) = "" Then
Cells(ligne, col) = f.Cells(2, c.Column)
Else
ligne = ligne + 1
Cells(ligne, col) = f.Cells(2, c.Column)
End If
End If
Next c
Next s
ligne = ligne + 1
Next i
Application.Calculation = xlAutomatic
End Sub