Private Sub Worksheet_Activate()
Dim tablo, resu(), i&, j%, n&
tablo = Feuil1.[A1].CurrentRegion.Resize(, 10)
ReDim resu(1 To 3 * UBound(tablo), 1 To 4)
For i = 2 To UBound(tablo)
For j = 2 To 10 Step 3
If tablo(i, j) <> "" Then
n = n + 1
resu(n, 1) = tablo(i, 1)
resu(n, 2) = tablo(i, j)
resu(n, 3) = tablo(i, j + 1)
resu(n, 4) = tablo(i, j + 2)
End If
Next j, i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] 'cellule à adapter
If n Then
.Resize(n, 4) = resu
.Resize(n, 4).Borders.Weight = xlThin 'bordures
End If
.Offset(n).Resize(Rows.Count - n - .Row + 1, 4).Delete xlUp 'RAZ en dessous
End With
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub