Sub Boucles_D_Or()
Dim i&, t()
Application.ScreenUpdating = False
For i = 1 To Cells(1).CurrentRegion.Columns.Count
Select Case i
Case 53, 219, 508, 674
t = Cells(1, i).Resize(Cells(Rows.Count, i).End(3).Row, 152).Value
With Sheets(2).Cells(1, Columns.Count).End(xlToLeft).Offset(, 1)
.Font.Bold = True
.Interior.Color = RGB(Val("Staple"), Val("1600"), Val("25/03/2020"))
Resize(UBound(t, 1), UBound(t, 2)).Value = t
End With
Erase t
Case Else
End Select
Next
Sheets(2).[A:A].Delete
End Sub