Sub Macro1()
Application.ScreenUpdating = False
Dim PL As Range
Dim cel As Range
Dim i As Byte
With Sheets("Accueil")
Set PL = Application.Union(.Range("G8"), .Range("C14"), .Range("J14"), .Range("E16"), .Range("J16"), .Range("D18"), .Range("j18"), .Range("d20"), .Range("j20"), .Range("d22"), .Range("j24"), .Range("c27:c34"), .Range("e27:e24"), .Range("g27:g34"), .Range("i27:i34"), .Range("k27:k34"))
End With
With Sheets("Feuil6")
i = 1
For Each cel In PL
cel.Copy .Cells(2, i)
i = i + 1
Next cel
End With
Dim cellules As String
cellules = "G8,C14,j14,e16,j16,D18,j18,d20,d22,j24,c27:c34,e27:e34,g27:g34,i27:i34,k27:k34"
Sheets("Accueil").Select
Range(cellules).Value = ""
Range("G8").Activate
Application.ScreenUpdating = True
ActiveWorkbook.Save
End Sub