Private Sub Worksheet_Activate()
Dim c As Range, w As Worksheet, col%, i&, j&, x$
Application.ScreenUpdating = False
[B6:M14,N15:O32].ClearContents 'RAZ
For Each c In [B5:O5]
col = c.Column
For Each w In Worksheets
If IsNumeric(w.Name) Then
With w.UsedRange
For i = 1 To .Rows.Count
If .Cells(i, 1) = c And .Cells(i, 5) <> "" Then
j = Application.Match(.Cells(i, 5), Columns(1), 0)
x = Cells(j, col)
Cells(j, col) = IIf(x = "", "", x & " ; ") & w.Name
Exit For
End If
Next i
End With
End If
Next w, c
End Sub