determiner une serie de jours ouvrés avant et après un weekend ou un jour ferié à partir d'une date

=SIERREUR(SI(LIGNES(C$4:C4)=1;SERIE.JOUR.OUVRE(C3-1;1;Feries);SERIE.JOUR.OUVRE(C3+6-JOURSEM(C3;2);1;Feries))/(SI(LIGNES(C$4:C4)=1;SERIE.JOUR.OUVRE(C3-1;1;Feries);SERIE.JOUR.OUVRE(C3+6-JOURSEM(C3;2);1;Feries))<=D$3);"")

=SIERREUR(SI(SERIE.JOUR.OUVRE(C4+6-JOURSEM(C4;2);-1;Feries)>D$3;SERIE.JOUR.OUVRE(D$3+1;-1;Feries);SERIE.JOUR.OUVRE(C4+6-JOURSEM(C4;2);-1;Feries));"")

Private Sub Worksheet_Change(ByVal Target As Range)
Dim deb As Date, fin As Date, dest As Range, d As Object, dat As Variant, resu(), flag As Boolean, n&
deb = [C3] 'à adapter
fin = [D3] 'à adapter
Set dest = [B3] 'à adapter
'---mémorisation des jours fériés pour accélérer---
Set d = CreateObject("Scripting.Dictionary")
For Each dat In [Feries].Value: d(dat) = "": Next
'---tableau des résultats---
ReDim resu(1 To fin - deb + 1, 1 To 3)
For dat = deb To fin
    If Not flag And Weekday(dat, 2) < 6 And Not d.exists(dat) Then
        flag = True
        n = n + 1
        resu(n, 1) = n
        resu(n, 2) = dat
    End If
    If flag And (Weekday(dat, 2) > 5 Or d.exists(dat)) Then flag = False: resu(n, 3) = dat - 1
Next
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
dest(2).Resize(Rows.Count - dest.Row, 3).Delete xlUp 'RAZ
If n Then
    If resu(n, 3) = "" Then resu(n, 3) = fin
    dest(2).Resize(n, 3) = resu
    dest(2, 2).Resize(n, 2).Interior.ColorIndex = 6 'jaune
    dest(2, 2).Resize(n, 2).Borders.Weight = xlHairline 'bordures
End If
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim deb As Date, fin As Date, dest As Range, d As Object, dat As Variant, resu(), n&, flag As Boolean, i&
deb = [A3] 'à adapter
fin = [A5] 'à adapter
Set dest = [C7] 'à adapter
'---mémorisation des jours fériés pour accélérer---
Set d = CreateObject("Scripting.Dictionary")
For Each dat In [Feries].Value: d(dat) = "": Next
'---tableau des résultats---
ReDim resu(1 To 2 * IIf(fin < deb, 0, fin - deb) + 3, 1 To 3)
n = -1
For dat = deb To fin
    If Not flag And Weekday(dat, 2) < 6 And Not d.exists(dat) Then
        flag = True
        n = n + 2
        resu(n, 1) = "PERIODE " & 1 + (n - 1) / 2
        resu(n, 2) = "DATE DE DEPART"
        resu(n, 3) = dat
        resu(n + 1, 2) = "DATE DE RETOUR"
    End If
    If flag And (Weekday(dat, 2) > 5 Or d.exists(dat)) Then flag = False: resu(n + 1, 3) = dat - 1
Next
If n > -1 Then If resu(n + 1, 3) = "" Then resu(n + 1, 3) = fin
resu(n + 2, 1) = "IMPUTATION BUDGETAIRE"
resu(n + 2, 3) = Application.VLookup("IMPUTATION BUDGETAIRE", dest.EntireColumn.Resize(, 3), 3, 0)
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
dest(2).Resize(Rows.Count - dest.Row, 3).Delete xlUp 'RAZ
dest(2).Resize(n + 2, 3) = resu
'---fusion des cellules---
If n > 1 Then
    For i = 1 To n Step 2
        dest(i + 1).Resize(2).Merge
        dest(i + 1).VerticalAlignment = xlCenter
    Next
ElseIf n = 1 Then
    dest(2, 2).Resize(2).Cut dest(2)
    dest(2).Resize(, 2).Merge
    dest(3).Resize(, 2).Merge
End If
dest(n + 3).Resize(, 2).Merge 'IMPUTATION BUDGETAIRE
'---bordures---
dest(2).Resize(n + 2, 3).Borders.Weight = xlThin 'bordures
Application.EnableEvents = True 'réactive les évènements
End Sub

Sub Transfert(dest As Range)
Dim F As Worksheet, lig&, n&, p&
Set dest = dest.Offset(-5) '1ère cellule du tableau
Set F = Feuil3 'CodeName de la feuille BASE DE DONNEES
If F.[G2] = "" Then lig = 2 Else lig = Application.Match(9 ^ 9, F.[G:G]) + 1
For n = 7 To dest.Row + dest.CurrentRegion.Rows.Count - 3 Step 2
    F.Cells(lig + p, 7) = dest(n, 3)
    F.Cells(lig + p, 8) = dest(n + 1, 3)
    p = p + 1
Next
F.Cells(lig, 9).Resize(p) = dest(n, 3)
For n = 1 To 6
    F.Cells(lig, n).Resize(p) = dest(n, 3)
Next
F.[A1].CurrentRegion.RemoveDuplicates _
    Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9), Header:=xlYes 'supprime les doublons
End Sub