Exporter des feuilles de calculs avec condition

Bonjour à tous,

Je souhaiterais apporter une modification à mon programme ci-dessous.

Aujourd'hui, le programme me permet de créer des fichiers Excel pour chaque feuille lorsqu'elles présentent une valeur dans la cellule "A4". Pour chaque fichier crée s'ajoute en plus la feuille "Notice lot".

Mon objectif est apporté une modification. Je souhaite que pour la feuille "Global", s'il y a une valeur dans la cellule "A4", de créer un nouveau fichier avec la feuille "Global" et la feuille "Notice Global".

Quelles modifications dois-je apporter pour y arriver ?

Merci pour votre aide.

Sub Séparer_les_feuilles()

    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim xWs As Worksheet
    Dim xWb As Workbook
    Dim xNWb As Workbook
    Dim FolderName As String
    Application.ScreenUpdating = False
    Set xWb = Application.ThisWorkbook

    DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
    FolderName = xWb.Path & "\" & Split(xWb.Name, ".")(0) & " " & DateString

    If Val(Application.Version) < 12 Then
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        FileExtStr = ".xlsx": FileFormatNum = 51
    End If

    MkDir FolderName

    For Each xWs In xWb.Worksheets
    On Error GoTo NErro
        If xWs.Name <> "Notice Lot" And xWs.Range("A4") <> "" Then
            xWb.Worksheets(Array("Notice Lot", xWs.Name)).Copy
            Set xNWb = ActiveWorkbook
            xFile = FolderName & "\" & xWs.Name & FileExtStr
            xNWb.BuiltinDocumentProperties("Title").Value = Worksheets(2).Name
            xNWb.SaveAs xFile, FileFormat:=FileFormatNum
            xNWb.Close False, xFile
        End If
NErro:
        xWb.Activate
    Next

        MsgBox "Les feuilles sont dans ce fichier " & FolderName
        Sheets("A trier").Activate
        Application.ScreenUpdating = True

End Sub

Salut,

Le fichier ci-joint est modifié selon ton souhait.

Amicalement.

Salut,

Super, merci pour votre aide !