Sub Merci_O_365()
Dim x As Worksheet, k&, st_R$, dl&, F As Worksheet: Set F = Sheets("Finale")
k = 1
For Each x In Worksheets
If x.Name <> "Finale" Then
st_R = st_R & x.Name & "!" & x.Range("C2", x.Cells(Rows.Count, "C").End(3)).Address & ","
End If
Next
formule = Mid(st_R, 1, Len(st_R) - 1)
F.[A2].Formula2 = "=VSTACK(" & formule & ")"
dl = F.Cells(Rows.Count, 1).End(3).Row
F.Range("B2:B" & dl).FormulaR1C1 = "=DATE(RIGHT(RC[-1],4),CHOOSE(LEFT(RC[-1])*1,1,4,7,10),1)"
F.Range("C2").Formula2 = "=SORT(UNIQUE(B2:B" & dl & "))"
With F.Range("D2:D" & F.Cells(Rows.Count, "C").End(3).Row)
.Formula2 = "=CEILING(MONTH(C2)/3,1)&""T ""&YEAR(C2)"
.Font.Bold = True
.Interior.Color = vbYellow
.Borders.Value = 1
End With
End Sub