Option Explicit
Dim Ws_Cible As Worksheet
Dim f As Worksheet
Dim DerLgn As Integer
Dim Col As Byte
Sub RécupérerEcartsMax()
Dim DerLgn As Integer
Application.ScreenUpdating = False
Set Ws_Cible = ActiveSheet
With Ws_Cible
.Cells.ClearContents
For Each f In Worksheets 'Pour chaque feuille du Fichier
If f.Name <> .Name Then 'si nom de la feuille f différent de la feuille Cible
DerLgn = f.Cells(f.Rows.Count, 10).End(xlUp).Row 'on récupérer la dernière ligne Non vide de la colonne J (10)
f.Range(f.Cells(2, 10), f.Cells(DerLgn, 10)).Copy 'on copie les valeurs de la plage ainsi définie ligne
Col = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1 'on détermine la dernière colonne Vide de la feuille Cible
.Cells(1, Col).Value = f.Name 'On colle le Nom de la feuille Source "f"
.Cells(2, Col).PasteSpecial xlPasteAll 'et a partir de la deuxième Ligne de cette Colonne les valeur récupérees
DerLgn = .Cells(.Rows.Count, Col).End(xlUp).Row 'on récupérer la dernière ligne Non vide de la Colonne "Col"
With .Range(.Cells(1, Col), .Cells(DerLgn, Col)) 'avec la palge ainsi définie
.Sort Key1:=Cells(1, Col), Order1:=xlDescending, Header:=xlYes 'On trie
End With
End If
Next f
.Cells(1, 1).Select
End With
End Sub