Option Explicit
Sub Transférer_et_trier_si_coloré()
Dim i As Long
Application.ScreenUpdating = False
Sheets("liste total ordre alphabétique").Columns(1).Clear
For i = 1 To Range("A65536").End(xlUp).Row
If Range("A" & i).Value <> "" And Range("A" & i).Interior.Color <> 16777215 Then Range("A" & i).Copy Destination:=Sheets("liste total ordre alphabétique").Range("a65536").End(3)(2)
Next
With Sheets("liste total ordre alphabétique")
.Activate
.Range("a1") = "Liste globale"
.Range("A:A").Sort Range("A1"), xlAscending, Header:=xlYes
.Columns(1).EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
End Sub