Sub Bouton2_QuandClic()
Dim data As New Collection
Dim i As Integer
Dim c As Range
data.Add "*"
'collection sans doublons des services
With Sheets("data")
On Error Resume Next
For Each c In .Range("c6:c" & .Range("c65536").End(xlUp).Row)
data.Add c, CStr(c)
Next c
On Error GoTo 0
End With
'boucle sur chaque élément de la collection
For i = 1 To data.Count
Sheets("DEP_SV").Range("d3") = data(i) 'place le nom du service
Sheets("DEP_SV").Copy After:=Sheets(Sheets.Count) 'copie la feuille
With ActiveSheet
.Calculate
.Name = IIf(i = 1, "DEP_Projets", data(i) & "_Projets") 'renomme la feuille
.Range("f8:k24") = .Range("f8:k24").Value 'colle en valeur
End With
Next i
End Sub