Sub CopieProjet()
Dim ShtD As Worksheet ' Feuille de destination
Dim ShtS As Worksheet ' Feuille source
Dim DLig As Long, NewLig As Long
' Définir la feuille de destination
Set ShtD = Sheets("CR")
' Pour chaque feuille
For Each ShtS In ThisWorkbook.Sheets
' Si le nom est différend de "CR"
If ShtS.Name <> "CR" Then
' On récupère la dernière ligne de la feuille CR
DLig = ShtD.Range("B" & Rows.Count).End(xlUp).Row
' On ajoute une ligne vide
NewLig = DLig + 2
' On copie / colle les zones que l'on souhaite
ShtS.Range("G2:S3").Copy Destination:=ShtD.Cells(NewLig, 2)
ShtS.Range("T36:V40").Copy Destination:=ShtD.Cells(NewLig, 17)
NewLig = NewLig + 3
ShtS.Range("B15:N24").Copy Destination:=ShtD.Cells(NewLig, 2)
' Etc ....
End If
Next ShtS
End Sub