Sub Resultat()
If [C1] < 0 Then Exit Sub
Dim t#, P&, dest As Range, rc&, tablo, maxi#, ncol%, resu(), i&, j%, dercol%, n&, k&
t = Timer
P = [C1] 'nombre de copies
Set dest = Sheets("Résultat").[A1] '1ère cellule des résultats, à adapter
rc = Rows.Count - dest.Row + 1
tablo = ActiveSheet.UsedRange.Offset(1) 'matrice, plus rapide
maxi = Application.Max(tablo)
ncol = UBound(tablo, 2)
ReDim resu(1 To rc, 1 To ncol)
For i = 1 To UBound(tablo)
For j = ncol To 1 Step -1
If tablo(i, j) <> "" Then Exit For
Next j
dercol = j
If dercol Then
n = n + 1
If n > rc Then GoTo 1
For j = 1 To dercol
resu(n, j) = tablo(i, j)
Next
If tablo(i, dercol) = maxi Then
For k = 1 To P
n = n + 1
If n > rc Then GoTo 1
For j = 1 To dercol
resu(n, j) = tablo(i, j)
Next j, k
End If
End If
Next i
'---restitution---
With dest
If n Then .Resize(n, ncol) = resu
.Offset(n).Resize(rc - n - .Row + 1, ncol).ClearContents 'RAZ en dessous
.Offset(, ncol).EntireColumn.Resize(, Columns.Count - ncol - .Column + 1).ClearContents 'RAZ à droite
With .Parent.UsedRange: End With 'actualise les barres de défilement
.Parent.Activate
End With
MsgBox "Feuille Résultat calculée en " & Format(Timer - t, "0.00 \sec")
Exit Sub
1 MsgBox "Tableau des résultats trop grand !", vbCritical
End Sub