Sub Synthese()
Dim xRg As Range, c As Range, xCopyTo As Range, sh As Worksheet, firstRow As Long, lastRow As Long, valeur As String
Sheets("Synthese").Range("A4:A" & Rows.Count).EntireRow.Delete
For Each sh In Worksheets
With sh
On Error Resume Next ' si erreur (texte pas trouvé) dans la suite du code, on continue
Set c = Nothing 'on remet c à nothing avant chaque recherche (indispensable)
'On recherche le texte "Project name" dans la colonne A
Set c = .Range("a:a").Find(What:="Project name", LookIn:=xlFormulas, LookAt:=xlWhole).Offset(1, 0) 'On ne copie que les données, pas la ligne d'en tête
On Error GoTo 0 'on rétablit l'interception des erreurs
If Not c Is Nothing Then 'si c est différent de nothing, c'est que la recherche a aboutit
firstRow = c.Row 'première ligne
lastRow = .Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne
Set xRg = .Range(.Cells(firstRow, "A"), .Cells(lastRow, "Q")) 'plage à considérer
Set xCopyTo = Sheets("Synthese").Range("C" & Rows.Count).End(xlUp).Offset(1) 'Destination pour la copie
xRg.Copy xCopyTo 'on copie xRg dans la destination
'on copie le nom du client dans la colonne B
xCopyTo.Offset(0, -1).Value = .Range("F1").Value 'Offset pour mettre les données les unes à la suite des autres
End If
End With
Next sh
For i = 4 To lastRow 'Recopie le nom du client dans chaque cellule vide
If Cells(i, 2) <> "" Then
valeur = Cells(i, 2).Value
ElseIf Cells(i, 2) = "" Then
Cells(i, 2).Value = valeur
End If
Next i
Sheets("Synthese").Range("A4").Formula = "=VLOOKUP(B4,ACCUEIL!$A$1:$F$86,5)"
Sheets("Synthese").Range("A4").Select
Selection.AutoFill Destination:=Range(Cells(4, 1), Cells(lastRow, "A")) 'Copie la formule jusqu'à la dernière ligne du tableau
Sheets("Synthese").Columns("i:p").Delete 'Suppression des colonnes I à P
Sheets("Synthese").Columns.AutoFit
End Sub