Option Explicit
Sub Regroop()
Application.ScreenUpdating = 0
Dim Sh As Worksheet, Ws1 As Worksheet
Dim i As Integer, Titre, Desti, Desti2, Col, Lig, Nblign, Shname
Set Ws1 = Sheets("recap")
Ws1.Range("A2:J1000").ClearContents
Feuil1.Select
For Each Sh In Worksheets
If Sh.Name <> "Base" And Sh.Name <> "Recap" And Sh.Name <> "Base2" And _
Sh.Name <> "Matrice" And Sh.Name <> "Accueil" And Sh.Name <> "New" Then
Set Desti = Sheets("recap").[A65000].End(xlUp)
If IsEmpty(Sh.[D7]) Then GoTo suivant
Lig = Sh.[d65000].End(xlUp).Row
Col = Sh.Range("d7").Resize(, 8)
Nblign = Lig - 7 + 1 ' nom de la personne copié X fois
Sh.Range("D7:L" & Lig).Copy Destination:=Desti(2)
Desti2 = Ws1.[J65000].End(xlUp).Row
Set Shname = Sh.[A2]: Shname.Copy
Ws1.Range("j" & Desti2 + 1, "j" & Desti2 + Nblign).PasteSpecial Paste:=xlPasteValues
End If
suivant:
Next
Application.CutCopyMode = False
End Sub