Option Explicit
Sub MAJ()
Dim c As Range
With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
With Sheets("Relance"): .Range(.Range("a2"), .Range("d2").End(xlDown)).Clear: End With
For Each c In Range("a2", Cells(Rows.Count, 1).End(3))
If c = "X" Then
With c
.Offset(, 1).Resize(, 3).Copy Destination:=Sheets("Relance").Range("a" & Rows.Count).End(xlUp)(2)
.Offset(, 5).Copy Destination:=Sheets("Relance").Range("d" & Rows.Count).End(xlUp)(2)
End With
End If
Next
With Sheets("Relance"): .Columns("A:D").EntireColumn.AutoFit: .Range("a1").CurrentRegion.Borders.Value = 1: End With
With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub