Sub Worksheet_Activate()
Dim Ligne%, L%, DL%
Application.ScreenUpdating = False
Ligne = 7
With Sheets("RT6000 FRANCE")
DL = .Range("A65500").End(xlUp).Row
[A7:D21].ClearContents
For L = 7 To DL
If .Cells(L, 1) <> "" Then
Cells(Ligne, 1) = .Cells(L, 1)
Cells(Ligne, 2) = .Cells(L, "D") & " x " & .Cells(L, "F")
Ligne = Ligne + 1
End If
Next L
End With
End Sub