Private Sub Worksheet_Activate()
Dim ncol%, tablo, nlig&, resu(), j%, i&, x, y, z, n&
With Feuil1.UsedRange
ncol = Application.Ceiling(.Columns.Count, 3) 'PLAFOND
tablo = .Resize(, ncol) 'matrice, plus rapide
nlig = .Rows.Count
End With
ReDim resu(1 To nlig * ncol / 3, 1 To 3)
For j = 1 To ncol Step 3
For i = 2 To nlig
x = tablo(i, j): y = tablo(i, j + 1): z = tablo(i, j + 2)
If x <> "" Or y <> "" Or z <> "" Then
n = n + 1
resu(n, 1) = x: resu(n, 2) = y: resu(n, 3) = z
End If
Next i, j
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination, à adapter
If n Then .Resize(n, 3) = resu
.Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
End Sub