Sub PA()
Dim ws As Worksheet, i As String
Application.ScreenUpdating = False
i = ActiveSheet.Name
For Each ws In worksheets
If ws.Name <> "Plan d'action" And ws.Name <> "Calendrier" Then
worksheets(ws.Name).Activate
Range("a1:j" & Range("B1000").End(xlUp).Row).Copy _
Destination:=Sheets("Plan d'action").Range("B65536").End(xlUp)(1).Offset(1, -1)
End If
Next ws:
Application.ScreenUpdating = True
End Sub