Sub Regroupement()
Dim X%
Dim DerL%
Dim ShtArr As Variant
Application.ScreenUpdating = False
ShtArr = Array(1, 5, 6, 8)
With Feuil1
.Range("A2:G" & .Range("A65535").End(xlUp).Row + 1).Clear
End With
For X = 0 To UBound(ShtArr)
DerL = Feuil1.Range("A65536").End(xlUp).Row
With Sheets(ShtArr(X))
.Range("A4:G" & .Range("A65535").End(xlUp).Row + 1).Copy Feuil1.Cells(DerL + 1, 1)
End With
Next X
Feuil1.Range("A2:G65535").Sort Key1:=Feuil1.Range("A2"), Order1:=xlAscending, Header:=xlGuess
Application.ScreenUpdating = True
End Sub