pppppppppppppppppppppppppppppppppppppppp

[nemisius]

pppppppppppppppppppppppppppppppppppppppp

 

[sousou]

Re : Code long. Demande d'aide pour accélération

Bonjour nemisius.
Si j'ai bien saisie le sens de ta question tu souhaites trier horizontalement chaque ligne??
Je te propose une solution qui utilise le collage transposition.
Je prend la zone à trier
je la copie dans une nouvelle feuille en collage spécial (transposition)
j'utilise le trie
je copie cette nouvelle zone
et je recolle avec une nouvelle transposition dans la zone d'origine
A voir.....

Sub TriTout()
premiereligne = 1
derniereligne = 150
premierecolonne = 2
dernierecolonne = 200
With ActiveSheet
Set z1 = .Range(.Cells(premiereligne, premierecolonne), .Cells(derniereligne, dernierecolonne))

ThisWorkbook.Sheets.Add
Set nf = ActiveSheet
z1.Copy
nf.Range("a1").PasteSpecial Transpose:=True
For Each i In nf.UsedRange.Columns

i.Sort (i.Rows(1))
n = n + 1
Next

nf.UsedRange.Copy
z1.PasteSpecial Transpose:=True
End With
Application.DisplayAlerts = False
nf.Delete
Application.DisplayAlerts = True
End Sub